FM Towns: Free Software Collection 6/FM Towns Free Software Collection 6.iso/t_os/colorful/source/colorful.bas

BASIC Source File | 1993-07-08 | 81KB | 1,132 lines

5 CLEAR ,,1024,970000,22648:ON ERROR GOTO 6:GOTO 10
6 CLS:BEEP:PRINT "メモリが足りません｡ 終了します":WAIT 300:END
10 DEFINT A-Z:DIM CO%(2),CH%(2048),G%(48000),COL$(5),COL%(5),NOU$(4),NOU%(4),MIDL$(3),MID%(3),OCM$(3),OCM%(3),SCM$(4),LUM$(6),LUM%(6),G2%(256),G3%(256),GD%(8192),PAL&(255),IP%(7,3),PAL$(2),BY&(15),CMD&(10),GBAK%(399999)
15 DIM FILE_NAME$(256),RADBUT$(9),RETFLG(9),XY(20,4),WC(12),SKB%(2687) 'for File Dialog
16 DEF FNFF$(F$)=LEFT$(KLEFT$(F$,KINSTR(F$+"        .",".")-1)+SPACE$(8),8)+LEFT$(KMID$(F$,KINSTR(F$+"        .","."),4)+SPACE$(4),4):DEF FNPR$(A)=CHR$(A MOD 256)+CHR$(A \ 256)
17 OFFSET&=0:FDX=16:FDY=2:FDXM=FDX*8:FDYM=FDY*19:MAXCMD=12:CANCMD=9:BUTCMD=12:RADBUT=10:RCMD=0:WC$="*.*":TM$=SPACE$(8):FDM$=SPACE$(68):RIFLG=0:BASCOM=1
18 INFOR$=STRING$(200,0):DIR$=SPACE$(65):DRV_SET$=STRING$(26,0):FILENAME$=SPACE$(15):KAKUNO$=FILENAME$:PATH_ALL$=WC$:DUMMYY$=SPACE$(14):DUMMYP$="."+CHR$(0):FOR A=0 TO 256:FILE_NAME$(A)=SPACE$(16):NEXT:FOR A=0 TO 9:RADBUT$(A)=SPACE$(60):NEXT
19 PATH$=SPACE$(255):DRIVE$=SPACE$(255):F_NAME$=SPACE$(255)
20 MCX=220:MCY=180:SCREEN@ 0:VERS$="1.45g":VDATE$="93/02/14":GOSUB *ABOUT_WRT:WAIT 150:OFA=&H3000:OFR=&H2000
30 MNDPF=1:SCSI=1     'mndpf=1:GT-4000/互換機  2:GT-6000
40 CLS:MABP=1:SAF=0:DI=3:PALM=0:FPAL=0:FCX=0:FCY=0:XLEN=1:YLEN=1:SCOM$=STRING$(64,0):PAR$=SCOM$:ON KEY(1) GOSUB *PALETTE_CHANGE:ON KEY(2) GOSUB *PF_PALETTE:KEY(1) ON:KEY(2) ON
50 FDPF$="A:\PREVIEW.PAT":FDSF$="A:\SCANDATA.TIF":DFD$="A:":DFF$="\GDATA.TIF":DPD$=DFD$:DPF$="\SCAN0001.SPF":MD$="A:\WORK"
60 ON ERROR GOTO 900:OPEN "I",#1,".\COLORFUL.ENV":MNDPF=ASC(INPUT$(1,1)):SCSI=ASC(INPUT$(1,1)):DUM=ASC(INPUT$(1,1)):FDPF$=INPUT$(DUM,1):DUM=ASC(INPUT$(1,1)):FDSF$=INPUT$(DUM,1):DFD$=INPUT$(1,1)+":":DUM=ASC(INPUT$(1,1)):DFF$=INPUT$(DUM,1):DPD$=DFD$
70 DUM=ASC(INPUT$(1,1)):DPF$=INPUT$(DUM,1):DUM=ASC(INPUT$(1,1)):MD$=INPUT$(DUM,1):CLOSE:ON ERROR GOTO 0
100 IF INKEY$="" THEN 1000
110 CONSOLE 5,1:LOCATE 20,0:PRINT "ColorfulStick 環境設定";
120 LOCATE 0,5:PRINT "使用機種 (1:GT-4000/FMSC-611G  2:GT-6000/FMSC6111G) ["+STR$(MNDPF)+"]";:MIN=1:MAX=2:YN=MNDPF:GOSUB *GETONEVAL:MNDPF=YN:CLS 1
130 LOCATE 0,5:PRINT "SCSI接続 (0:接続無し  1:接続あり) ["+STR$(SCSI)+"]";:MIN=0:MAX=1:YN=SCSI:GOSUB *GETONEVAL:SCSI=YN:CLS 1
140 LOCATE 0,6:M$="プレビューファイル ["+FDPF$+"]":YNM$=FDPF$:GOSUB *GETSTR:FDPF$=YNM$:CLS 3:IF RIGHT$(FDPF$,4)<>".PAT" THEN IF INSTR(FDPF$,".")=0 THEN FDPF$=FDPF$+".PAT" ELSE FDPF$=LEFT$(FDPF$,INSTR(FDPF$,"."))+"PAT"
150 LOCATE 0,6:M$="スキャンファイル ["+FDSF$+"]":YNM$=FDSF$:GOSUB *GETSTR:FDSF$=YNM$:CLS 3:IF RIGHT$(FDSF$,4)<>".TIF" THEN IF INSTR(FDSF$,".")=0 THEN FDSF$=FDSF$+".TIF" ELSE FDSF$=LEFT$(FDSF$,INSTR(FDSF$,"."))+"TIF"
160 'LOCATE 0,6:M$="デフォルトセーブファイル ["+DFD$+DFF$+"]":YNM$=DFD$+DFF$:GOSUB *GETSTR:IF INSTR(YNM$,":")=0 THEN DFF$=YNM$ ELSE YN=INSTR(YNM$,":"):DFD$=LEFT$(YNM$,YN):DFF$=RIGHT$(YNM$,LEN(YNM$)-YN)
170 'CLS 3:LOCATE 0,6:M$="デフォルトパラメータファイル ["+DPF$+"]":YNM$=DPF$:GOSUB *GETSTR:DPF$=YNM$:CLS 3
180 LOCATE 0,6:M$="モジュール格納パス ["+MD$+"]":YNM$=MD$:GOSUB *GETSTR:MD$=YNM$:WHILE (RIGHT$(MD$,1)="\"):MD$=LEFT$(MD$,LEN(MD$)-1):WEND:CLS 3
200 DPD$=DFD$:ON ERROR GOTO 950:OPEN "O",#1,".\COLORFUL.ENV"
210 PRINT #1,CHR$(MNDPF,SCSI);:PRINT #1,CHR$(LEN(FDPF$))+FDPF$;::PRINT #1,CHR$(LEN(FDSF$))+FDSF$;:PRINT #1,LEFT$(DFD$,1);:PRINT #1,CHR$(LEN(DFF$))+DFF$;
220 PRINT #1,CHR$(LEN(DPF$))+DPF$;:PRINT #1,CHR$(LEN(MD$))+MD$;:CLOSE:ON ERROR GOTO 850
230 A=0:SAVE@ FDPF$,G%
240 A=1:OPEN "O",#1,FDSF$:ON ERROR GOTO 880:PRINT #1,"DUMMYだよ";:CLOSE:ON ERROR GOTO 0:GOTO 1000
500 *GETONEVAL
510 YNX=POS(0)
520 YNM$=INPUT$(1):LOCATE 5,YNX:PRINT YNM$;:IF INSTR("0123456789"+CHR$(13),YNM$)=0 THEN BEEP:GOTO 520
530 IF YNM$=CHR$(13) THEN RETURN ELSE IF VAL(YNM$)<MIN OR VAL(YNM$)>MAX THEN BEEP:GOTO 520
540 YN=VAL(YNM$):RETURN
600 *GETSTR
610 CLS 3:LOCATE 0,6:PRINT M$:LINE INPUT YN$:IF YN$="" THEN RETURN
620 FOR A=1 TO LEN(YN$):A$=MID$(YN$,A,1):IF A$>="a" AND A$=<"z" THEN A$=CHR$(ASC(A$)-32):MID$(YN$,A,1)=A$
630 IF INSTR("ABCDEFGHIJKLMNOPQRSTUVWXYZ.\0123456789$&#%^~!:_@",A$)=0 THEN A=500
640 NEXT:IF A>300 THEN BEEP:GOTO 610
650 YNM$=YN$:RETURN
700 *READ_REX:LOADM MD$+"\GTPOINT.REX",OFR:IF SCSI=0 THEN LOADM MD$+"\RS232C.REX",OFA ELSE LOADM MD$+"\SCSI.REX",OFA
710 LOADM MD$+"\BAS_LIB.REX",OFFSET&:RETURN
750 RESUME NEXT
850 IF A=0 THEN RESUME 240 ELSE ON ERROR GOTO 0:RESUME 1000
880 ON ERROR GOTO 0:CLS:PRINT USING "実行環境整備中に異常が発生しました｡ erl: ##### err: ###";ERL;ERR;:BEEP:CLOSE:WAIT 300:END
900 ON ERROR GOTO 0:CLOSE:RESUME 110
950 IF ERR=64 THEN KILL ".\COLORFUL.ENV":RESUME
960 ON ERROR GOTO 0:CLS:PRINT USING "環境ファイル書き込み中に異常が発生しました｡ erl: ##### err: ###";ERL;ERR;:BEEP:CLOSE:WAIT 300:RESUME 1000
1000 GOSUB *READ_REX:CALLM OFFSET&,7,VARPTR(INFOR$):ON ERROR GOTO 750:GOSUB *GETCD:ON ERROR GOTO 0 ':SHELL "A:":GOSUB *GETCD:ON ERROR GOTO 0
1010 A&=CALLM(OFA,VARPTR(CMD&(0))):IF A&<>0 AND SCSI=1 THEN BEEP:PRINT "SCSIがスキャナに未接続です":END ELSE FOR A=0 TO 10:CMD&(A)=CMD&(A)+OFA:NEXT
1020 GETH&=CMD&(0):PUTC&=CMD&(1):RCLOSE&=CMD&(2):RCMD&=CMD&(3):RGET1&=CMD&(4):RINIT&=CMD&(5):RPUT1&=CMD&(6):RSTAT2&=CMD&(7):RSTAT&=CMD&(8):RGET2&=CMD&(9):RPUT2&=CMD&(10):ERRC&=&H7FFFFFFF:PSCM=10:SCM=0:DSCM=SCM
1030 DEF FNF$(F)=RIGHT$("  "+STR$(F),3):DEF FNG$(G)=RIGHT$("  "+STR$(G),4):DEF FNM(X1,X2)=(X2-X1)\2+X1:DEF FND(N)=CVI(INPUT$(2,N)):DEF FNL$(A$)=CHR$(LEN(A$))+A$:DEF FND$(N)=INPUT$(ASC(INPUT$(1,N)),N):IF SCSI<>1 THEN CALLM RINIT&:CALLM RCLOSE&
1040 RESTORE 1110:FOR A=0 TO 2:READ CO%(A):NEXT:GOSUB *SET_DPI:DIM DPI%(MNDP):FOR A=0 TO MNDP:READ DPI%(A):NEXT
1050 RESTORE *N_DPI:FOR A=0 TO 5:READ COL$(A),COL%(A):NEXT:FOR A=0 TO 4:READ NOU$(A),NOU%(A):NEXT:FOR A=0 TO 3:READ MIDL$(A),MID%(A):NEXT
1060 FOR A=0 TO 3:READ OCM$(A),OCM%(A):NEXT:FOR A=0 TO 3:READ SCM$(A):NEXT:FOR A=0 TO 6:READ LUM$(A),LUM%(A):NEXT:FOR A=0 TO 7:FOR B=0 TO 3:READ IP%(A,B):NEXT:NEXT:FOR A=0 TO 2:READ PAL$(A):NEXT:GOTO 1220
1070 *SET_DPI:ON MNDPF+1 GOTO 1080,1090,1100
1080 CLS:PRINT "指定された機種は対応してません｡":END
1090 RESTORE *DPI1:MNDP=15:RETURN
1100 RESTORE *DPI2:MNDP=18:RETURN
1110 DATA 4,2,1
1120 *DPI1:DATA 50,72,80,90,100,120,144,150,160,180,200,240,300,320,360,400
1130 *DPI2:DATA 50,72,75,80,90,100,120,144,150,160,180,200,240,300,320,360,400,480,600
1140 *N_DPI:DATA "  モノクロ  ",0,モノクロ(赤),16,モノクロ(緑),32,モノクロ(青),48,カラー(面順),1,カラー(線順),2
1150 DATA " ＣＲＴ(２値表示) ",1,"  ＣＲＴ(中間調)  ",2," プリンタ(高密度) ",0," プリンタ(低密度) ",16,プリンタ(文字混在),32
1160 DATA 中間調Ａ(硬調),0,中間調Ｂ(軟調),16,中間調Ｃ(網点),32,中間調処理なし,1
1170 DATA "Impact Dot Printer",16,"  熱転写プリンタ  ",32," Ink-Jet Printer  ",64,"ＣＲＴディスプレイ",128
1180 DATA "     16色モード   ","   32768色モード  "," 256色モード(2Bit)"," 256色モード(3Bit)"
1190 DATA "|        -3",253," |       -2",254,"  |      -1",255,"   |      0",0,"    |     1",1,"     |    2",2,"      |   3",3
1200 DATA 0,0,0,0 ,3,0,0,255 ,28,0,255,0 ,31,0,255,255 ,224,255,0,0 ,227,255,0,255 ,252,255,255,0 ,255,255,255,255
1210 DATA " モノクロ多階調モード "," パレット4096色モード ","パレット1677万色モード"
1220 ESC$=CHR$(27):STX$=CHR$(2):ACK$=CHR$(6):CAN$=CHR$(24):CONSOLE 0,25
1230 TY=1:CCOL=1:DFO=1:MID=0:SZOMX=100:SZOMY=100:R1=72:R2=72:OCM=128:NOU=1:LUM=0:MAX=8*(INT((8.56!*R1*SZOMX/100)/8)):MAY=INT(11.6!*R2*SZOMY/100):XST=0:YST=0:XEN=479:YEN=639:GOSUB *SCREEN_MODE:GOSUB *PALETTE_PALETTE:GOTO *MENU
1240 *READ:CLS:GOSUB *SCREEN_MODE:MAX=8*(INT((8.56!*R1*SZOMX/100)/8)):MAY=INT(11.6!*R2*SZOMY/100)
1250 IF XST+XEN>MAX-1 THEN PRINT USING "主走査方向領域(####)をはみ出しました。";MAX:RETURN
1260 IF YST+YEN>MAY-1 THEN PRINT USING "副走査方向領域(####)をはみ出しました。";MAY:RETURN
1270 IF PALM=0 THEN GOSUB *PALETTE_PALETTE ELSE GOSUB *PALETTE_SET
1280 PIT&=CALLM(RINIT&):SCOM$="C":PAR$=CHR$(CCOL):GOSUB *SENDDATAC:SCOM$="D":IF PALM<>0 AND SCM<>1 THEN GOSUB *DEPTH_SET ELSE PAR$=CHR$(DFO)
1285 GOSUB *SENDDATA:SCOM$="B":PAR$=CHR$(MID):GOSUB *SENDDATA:SCOM$="H":PAR$=CHR$(SZOMX)+CHR$(SZOMY):GOSUB *SENDDATA
1290 SCOM$="M":PAR$=CHR$(OCM):GOSUB *SENDDATA:SCOM$="L":PAR$=CHR$(LUM):GOSUB *SENDDATA:SCOM$="Z":PAR$=CHR$(NOU):GOSUB *SENDDATA:SCOM$="R":PAR$=FNPR$(R1)+FNPR$(R2):GOSUB *SENDDATA
1300 SCOM$="A":PAR$=FNPR$(XST)+FNPR$(YST)+FNPR$(XEN+1)+FNPR$(YEN+1):IF (PALM=0 OR SCM=1) OR (PALM=1 AND SCM=2) THEN GOSUB *SENDDATA:A&=1
1310 IF CCOL=0 OR CCOL=32 THEN CCO0=0
1320 IF CCOL=16 THEN CCO0=1 ELSE IF CCOL=48 THEN CCO0=2
1330 IF CCOL=1 OR CCOL=2 THEN CCO0=0:CCO1=2 ELSE CCO1=CCO0
1340 MODE&=FPAL*16777216+PALM*65536+TY*256+SCM:GRAP&=VARPTR(CH%(0)):DUM=0:ON SCM+1 GOTO *SCAN_16,*SCAN_32768,*SCAN_256
1350 *SCAN_16:ON PALM GOTO 1870 '     データＲＥＡＤ
1360 IF TY=1 THEN *DIR_Y16
1370 *DIR_T16:IF CCOL=1 THEN 1390
1380 FOR L=0 TO YEN:FOR COL=CCO0 TO CCO1:GOTO *WAIT_T16
1390 FOR COL=CCO0 TO CCO1:FOR L=0 TO YEN
1400  *WAIT_T16
1410   IF INKEY$=ESC$ THEN GOSUB *SENDC:L=YEN+1:COL=3:GOTO 1450
1420   A&=CALLM(GETH&,VARPTR(GD%(0)),A&):IF A&=ERRC& THEN *ERR2
1430   CALLM OFR,MODE&,XEN,VARPTR(GD%(0)),GRAP&,0,COL
1440   PUT@ (0,L)-(XEN,L),CH%,OR,CO%(COL)
1450 NEXT:NEXT:CALLM RCLOSE&,PIT&
1460 RETURN
1470 *DIR_Y16:GOSUB *YEN_CHK_MABP:XEN1=(XEN+1)*MABP-1:LLEN=MSX-YEN*MABP:IF CCOL=1 THEN 1490
1480 FOR L=MSX TO LLEN STEP -1*MABP:FOR COL=CCO0 TO CCO1:GOTO *WAIT_Y16
1490 FOR COL=CCO0 TO CCO1:FOR L=MSX TO LLEN STEP -1*MABP
1500  *WAIT_Y16
1510   IF INKEY$=ESC$ THEN GOSUB *SENDC:L=-1:COL=3:IF CCO0=CCO1 THEN LOCATE 40,24:COLOR 4:PRINT "スキャナからの読込を中止しました。";:COLOR 7:GOTO 1550 ELSE 1550
1520   A&=CALLM(GETH&,VARPTR(GD%(0)),A&):IF A&=ERRC& THEN *ERR2
1530   CALLM OFR,MODE&,XEN,VARPTR(GD%(0)),GRAP&,0,COL
1540   PUT@ (L-MABP+1,0)-(L,XEN1),CH%,OR,CO%(COL)
1550 NEXT:NEXT:CALLM RCLOSE&,PIT&
1560 RETURN
1570 *SCAN_32768
1580 IF TY=1 THEN *DIR_Y32
1590 *DIR_T32
1600 *DIR_T:IF CCOL=2 THEN FOR L=0 TO YEN:FOR COL=CCO0 TO CCO1:GOTO *WAIT_T32
1610 FOR COL=CCO0 TO CCO1:FOR L=0 TO YEN
1620  *WAIT_T32
1630   IF INKEY$=ESC$ THEN GOSUB *SENDC:L=YEN+1:COL=3:GOTO 1670
1640   A&=CALLM(GETH&,VARPTR(GD%(0)),A&):IF A&=ERRC& THEN *ERR2
1650   CALLM OFR,MODE&,XEN,VARPTR(GD%(0)),VARPTR(CH%(0)),0,COL,DFO
1660   PUT@A (0,L)-(XEN,L),CH%,OR
1670 NEXT:NEXT:CALLM RCLOSE&,PIT&
1680 RETURN
1690 *DIR_Y32
1700 *DIR_Y:GOSUB *YEN_CHK:LLEN=MSX-YEN:IF CCOL=2 THEN FOR L=MSX TO LLEN STEP -1:FOR COL=CCO0 TO CCO1:GOTO *WAIT_Y32
1710 FOR COL=CCO0 TO CCO1:FOR L=MSX TO LLEN STEP -1
1720  *WAIT_Y32
1730   IF INKEY$=ESC$ THEN GOSUB *SENDC:L=-1:COL=3:GOTO 1770
1740   A&=CALLM(GETH&,VARPTR(GD%(0)),A&):IF A&=ERRC& THEN *ERR2
1750 CALLM OFR,MODE&,XEN,VARPTR(GD%(0)),VARPTR(CH%(0)),0,COL,DFO
1760 PUT@A (L,0)-(L,XEN),CH%,OR
1770 NEXT:NEXT:CALLM RCLOSE&,PIT&
1780 RETURN
1790 *SCAN_256:ON PALM GOTO 1850,1870,1880
1800 IF DFO=2 THEN 1830
1810 '
1820   IF TY=0 THEN *DIR_T ELSE *DIR_Y
1830 '
1840   IF TY=0 THEN *DIR_T ELSE *DIR_Y
1850 '
1860   IF TY=0 THEN *DIR_T ELSE *DIR_Y
1870 GOTO 1890
1880 '
1890 IF TY=1 THEN *DIR_YP ELSE IF (PALM<>1 OR SCM<>2) THEN CALLM RCLOSE&,PIT&:GOTO *DIR_TPM
1900 FOR L=0 TO YEN:FOR COL=0 TO 2
1910   IF INKEY$=ESC$ THEN GOSUB *SENDC:L=YEN+1:COL=3:NEXT:GOTO 1960
1920   A&=CALLM(GETH&,VARPTR(GD%(0)),A&):IF A&=ERRC& THEN *ERR2
1930 CALLM OFR,MODE&,XEN,VARPTR(GD%(0)),VARPTR(G%(0)),0,COL,1
1940 NEXT
1950   CALLM OFR,MODE&,XEN,VARPTR(CH%(0)),VARPTR(G%(0)),VARPTR(PAL&(0)),0,0:PUT@A (0,L)-(XEN,L),CH%,PSET
1960 NEXT:CALLM RCLOSE&,PIT&:RETURN
1970 *DIR_YP:GOSUB *YEN_CHK:LLEN=MSX-YEN:IF (PALM<>1 OR SCM<>2) THEN CALLM RCLOSE&,PIT&:GOTO *DIR_YPM
1980 FOR L=MSX TO LLEN STEP -1:FOR COL=0 TO 2
1990   IF INKEY$=ESC$ THEN GOSUB *SENDC:L=-1:COL=3:NEXT:GOTO 2040
2000   A&=CALLM(GETH&,VARPTR(GD%(0)),A&):IF A&=ERRC& THEN *ERR2
2010 CALLM OFR,MODE&,XEN,VARPTR(GD%(0)),VARPTR(G%(0)),0,COL,1
2020 NEXT
2030   CALLM OFR,MODE&,XEN,VARPTR(CH%(0)),VARPTR(G%(0)),VARPTR(PAL&(0)),0,0:PUT@A (L,0)-(L,XEN),CH%,PSET
2040 NEXT:CALLM RCLOSE&,PIT&
2050 RETURN
2060 *DIR_TPM:GOSUB *PMCRED:Y=0:IF ((YEN+1) MOD (A+1)) THEN X=((YEN+1) MOD (A+1))-1 ELSE X=0
2065 WHILE Y<YEN:IF X=0 THEN X=Y+A:NA=A ELSE NA=X:X=Y+((YEN+1) MOD (A+1))-1
2070 GOSUB *SCROLL_CHECK_XOFY:PIT&=CALLM(RINIT&):SCOM$="A":PAR$=FNPR$(XST)+FNPR$(YST+Y)+FNPR$(XEN+1)+FNPR$((X-Y)+1):GOSUB *SENDDATA:A&=1
2080  FOR L=Y TO X:FOR COL=0 TO 2:LINE (0,456)-(63,471),PSET,0,BF:SYMBOL (0,456),"("+RIGHT$("    "+STR$(CINT(L/(YEN+1)*100)),4)+" %)",1,1,7
2090   IF INKEY$=ESC$ THEN GOSUB *SENDC:L=YEN+1:COL=3:Y=Y+512:NEXT:NEXT:CALLM RCLOSE&,PIT&:GOTO 2160
2100   A&=CALLM(GETH&,VARPTR(GD%(0)),A&):IF A&=ERRC& THEN *ERR2
2110   CALLM OFR,MODE&,XEN,VARPTR(GD%(0)),VARPTR(GBAK%((L-Y)*LBC)),0,COL,1
2120  NEXT:NEXT:CALLM RCLOSE&,PIT&
2130  FOR L=Y TO X:IF INKEY$=ESC$ THEN L=YEN+1:Y=Y+512:GOTO 2150
2140   CALLM OFFSET&,9,&H14,VARPTR(GBAK%((L-Y)*LBC)),&H14,VARPTR(G%(0)),LBC*2:CALLM OFR,MODE&,XEN,VARPTR(CH%(0)),VARPTR(G%(0)),VARPTR(PAL&(0)),0,0:PUT@A (0,L)-(XEN,L),CH%,PSET
2150  NEXT
2160 Y=Y+NA+1:NA=A:X=0:WEND
2170 X=0:Y=0:GOSUB *SCROLL_CHECK_XOFY:RETURN
2200 *DIR_YPM:GOSUB *PMCRED:LLEN=MSX-YEN:Y=MSX:IF ((YEN+1) MOD (A+1)) THEN X=((YEN+1) MOD (A+1))-1 ELSE X=0
2210 WHILE Y>LLEN:GOSUB *SCROLL_CHECK_YOFX:IF X=0 THEN X=Y-A:NA=A ELSE NA=X:X=Y-((YEN+1) MOD (A+1))+1
2220 PIT&=CALLM(RINIT&):SCOM$="A":PAR$=FNPR$(XST)+FNPR$(YST+(MSX-Y))+FNPR$(XEN+1)+FNPR$((Y-X)+1):GOSUB *SENDDATA:A&=1
2230  FOR L=Y TO X STEP -1:FOR COL=0 TO 2:LINE (0,456)-(63,471),PSET,0,BF:SYMBOL (0,456),"("+RIGHT$("    "+STR$(CINT((MSX-L)/(YEN+1)*100)),4)+" %)",1,1,7
2240   IF INKEY$=ESC$ THEN GOSUB *SENDC:L=-1:COL=3:Y=Y-A*2-2:NEXT:NEXT:GOTO 2310
2250   A&=CALLM(GETH&,VARPTR(GD%(0)),A&):IF A&=ERRC& THEN *ERR2
2260   CALLM OFR,MODE&,XEN,VARPTR(GD%(0)),VARPTR(GBAK%((Y-L)*LBC)),0,COL,1
2270  NEXT:NEXT:CALLM RCLOSE&,PIT&
2280  FOR L=Y TO X STEP -1:IF INKEY$=ESC$ THEN L=-1:Y=Y-A*2-2:GOTO 2300
2290   CALLM OFFSET&,9,&H14,VARPTR(GBAK%((Y-L)*LBC)),&H14,VARPTR(G%(0)),2048:CALLM OFR,MODE&,XEN,VARPTR(CH%(0)),VARPTR(G%(0)),VARPTR(PAL&(0)),0,0:PUT@A (L,0)-(L,XEN),CH%,PSET
2300  NEXT
2310 Y=Y-NA-1:X=0:NA=A:WEND
2320 X=0:Y=0:GOSUB *SCROLL_CHECK_YOFX:RETURN
2330 *SCROLL_CHECK_YOFX:FCX=X:FCY=Y:MMX=Y:MMY=0:GOSUB *SCROLL_CHECK:X=FCX:Y=FCY:RETURN
2340 *SCROLL_CHECK_XOFY:FCX=X:FCY=Y:MMX=0:MMY=X:GOSUB *SCROLL_CHECK:X=FCX:Y=FCY:RETURN
2350 *PMCRED:COLOR 7:LOCATE 0,19:PRINT "パレットモードスキャン実行中...":PRINT USING "読み取りサイズ #### × ####";XEN+1;YEN+1
2360 PRINT USING "カラーデプス # bits (#########,色)";DFB;8^DFB;
2370 LBC=(XEN+1)*2:A=CINT(327680/LBC+.49!)-1:RETURN
2380 *YEN_CHK:IF YEN>BSX THEN MSX=BDX ELSE MSX=BSX
2390 RETURN
2400 *YEN_CHK_MABP:IF YEN*MABP>BSX THEN MSX=BDX ELSE MSX=BSX
2410 RETURN
2500 *SENDDATA2C:A&=CALLM(PUTC&,ASC(SCOM$),VARPTR(PAR$)):IF A&<>ERRC& THEN RETURN ELSE *SENDDATA2
2510 *SENDDATAC:A&=CALLM(PUTC&,ASC(SCOM$),VARPTR(PAR$)):IF A&<>ERRC& THEN RETURN
2520 *SENDDATA:A&=CALLM(PUTC&,ASC(SCOM$),VARPTR(PAR$)):IF A&=ERRC& THEN *ERR
2530 RETURN
2540 *SENDDATA2:A&=CALLM(PUTC&,ASC(SCOM$),VARPTR(PAR$)):IF A&=ERRC& THEN *ERR3
2550 RETURN
2560 *SENDC:CALLM RPUT1&,ASC(CAN$):RETURN
2570 *SENDA:CALLM RPUT1&,ASC(ACK$):RETURN
2580 *SENDG:RETURN 'SCSI･RS共､REXルーチン内に内包
2590 *ERR:CLS:BEEP:PRINT RIGHT$(SCOM$,1);"コマンドにエラーが発生しました。":CALLM RCLOSE&,PIT&:RETURN 2600
2600 WAIT 400:RETURN
2610 *ERR2:CLS:PRINT "通信回線にエラーが発生しました。":CALLM RCLOSE&,PIT&::WAIT 400:RETURN
2620 *ERR3:BEEP:LOCATE 20,24:PRINT RIGHT$(SCOM$,1);"コマンドにエラーが発生しました。";:CALLM RCLOSE&,PIT&:FOR DUM=0 TO 32000:NEXT:LOCATE 20,24:PRINT SPC(40);:RETURN 2600
2630 *SCAN_PUT:CLS:OPALM=PALM:GOSUB *SCREEN_MODE:ON ERROR GOTO 2650:LOAD@ FDSF$:PS$=FDSF$:GOSUB *PALETTE_LOAD_IN:GOSUB *PALETTE_CHANGE
2640 PALM=OPALM:ON ERROR GOTO 0:GOSUB *PALETTE_INI:RETURN
2650 GOSUB *PALETTE_PALETTE:RESUME 2640
2660 *PREV_PUT:PSCM=4:SCREEN@ 0:PALETTE:MCX=220:MCY=180
2670 *PREV_PUT_IN:ON ERROR GOTO *PREV_ERR:LOAD@ FDPF$,G%:ON ERROR GOTO 0:CLS:PUT@ (60,0)-(639,423),G%,PSET,4:RETURN
2680 *MENU_WRT:GET@A (MCX,MCY)-(MCX+199,MCY+119),G%:LINE (MCX,MCY)-(MCX+199,MCY+119),PSET,7,BF,1:MOUSE 0:MOUSE 1,MCX+100,MCY+60,1:MOUSE 4,MCX,MCY,MCX+199,MCY+119:RETURN
2690 *MOUSE_GET:A=0:MMX=MOUSE(0)-MCX:MMY=MOUSE(1)-MCY:IF MOUSE(2,0)=0 THEN A$=INKEY$:IF A$=CHR$(13) OR A$=CHR$(24) THEN A=ASC(A$):RETURN ELSE *MOUSE_GET
2700 *MOUSE_CHK:WHILE MOUSE(6,0)=0:WEND:RETURN
3000 *MENU:IF PSCM<>1 THEN MCX=220:MCY=180 ELSE IF ZMFV=1 THEN MCX=156:MCY=68 ELSE MCX=60:MCY=60
3010 GET@A (MCX,MCY)-(MCX+199,MCY+119),G%
3020 *MENU_IN:GOSUB *PALETTE_INI:LINE (MCX,MCY)-(MCX+199,MCY+119),PSET,7,BF,1:A&=FRE(4):FOR A=0 TO 128:A$=INKEY$:NEXT
3030 SYMBOL (MCX+4,MCY+2), "   仮読込       読込    ",1,1,4:SYMBOL (MCX+4,MCY+22)," パラメータ  モード設定 ",1,1,4:SYMBOL (MCX+4,MCY+42),"イメージ設定パレット設定",1,1,4:SYMBOL (MCX+4,MCY+62),"解像度&倍率   画面領域  ",1,1,4
3040 SYMBOL (MCX+3,MCY+82),"ファイル関連    終了    ",1,1,4
3050 LINE (MCX+1,MCY+101)-(MCX+198,MCY+118),PSET,3,BF,0:SYMBOL (MCX+4,MCY+102),"ColorfulStick Ver. "+VERS$,1,.5!,4:SYMBOL (MCX+4,MCY+110),"(C)1990-Aspergillus Valley",.9!,.5!,5
3060 LINE (MCX+1,MCY+20)-(MCX+198,MCY+20),PSET,7:LINE (MCX+1,MCY+40)-(MCX+198,MCY+40),PSET,7:LINE (MCX+1,MCY+60)-(MCX+198,MCY+60),PSET,7:LINE (MCX+1,MCY+80)-(MCX+198,MCY+80),PSET,7:LINE (MCX+1,MCY+100)-(MCX+198,MCY+100),PSET,7
3070 LINE (MCX+99,MCY+1)-(MCX+99,MCY+100),PSET,7
3080 MOUSE 0:MOUSE 1,MCX+100,MCY+60,1:MOUSE 4,MCX,MCY,MCX+199,MCY+119
3090 IF MOUSE (2,0) THEN A=MOUSE(6,0):GOSUB *MOUSE_CHK ELSE 3090
3100 MMX=MOUSE(0)-MCX:MMY=MOUSE(1)-MCY
3110 IF MMY>100 THEN GOSUB *ABOUT:GOTO *MENU_IN
3120 CMD=(MMY) \ 20:CMD=CMD*2+((MMX) \ 99):MMX=(CMD MOD 2)*99+MCX:MMY=(CMD \ 2)*20+MCY:LINE (MMX+1,MMY+1)-(MMX+98,MMY+19),XOR,7,BF
3130 LINE (MCX,MCY)-(MCX+199,MCY+119),PSET,7,BF,1:ON CMD+1 GOTO *PREVIEW,*READ_S,*PARA,*MODE,*IMAGE,*PALETTE,*ZOOM,*AREA,*FILE,*END:GOTO *MENU_IN
3140 *NON_SAP:LINE (MCX+114,MCY+99)-(MCX+199,MCY+119),PSET,7,B:SYMBOL (MCX+124,MCY+101),"メニュー",1,1,4:SYMBOL (MCX+4,MCY+22),"この機能は現在",1,1,4:SYMBOL (MCX+4,MCY+40),"サポートされていません。",1,1,4:WHILE MOUSE(6,0)=0:WEND:RETURN
3500 *ABOUT:GOSUB *ABOUT_WRT:GOSUB *MOUSE_CHK:RETURN
3510 *ABOUT_WRT:LINE (MCX,MCY)-(MCX+199,MCY+119),PSET,7,BF,1:SYMBOL (MCX+3,MCY+17),"ColorfulStick",1,1,4,,,10:SYMBOL (MCX+3,MCY+48),"Version "+VERS$+" ("+VDATE$+")",1,1,5,,,5:SYMBOL (MCX+3,MCY+66),"Copyright 1990-",1,1,3,,,8
3520 SYMBOL (MCX+6,MCY+84),"Studio Aspergillus Valley",.85!,1,6,,,24:SYMBOL (MCX+44,MCY+102),"＝ＯｃＴｏｈ[ｵｸﾄ]＝",1,1,6,,,9:GET@A (MCX+3,MCY+17)-(MCX+110,MCY+34),GD%:FOR A=1 TO 10:Y=MCY+(17-A):PUT@A (MCX+3,Y)-(MCX+110,Y+17),GD%,PSET,1+A*.075!,1+A/10:NEXT
3530 CIRCLE (MCX+162,MCY+12),4,6,,,,F,,2:LINE (MCX+3,MCY+41)-(MCX+196,MCY+44),PSET,6,BF,2:RETURN
4000 *PREVIEW
4010 SYMBOL (MCX+4,MCY+22),"  仮読込を実行します。  ",1,1,4:SYMBOL (MCX+6,MCY+101),"    取消        実行",1,1,4:LINE (MCX+1,MCY+99)-(MCX+198,MCY+99),PSET,7:LINE (MCX+132,MCY+99)-(MCX+165,MCY+119),PSET,5,B,&H5555
4020 SYMBOL (MCX+126,MCY+79),"まびき",1,.5!,4:SYMBOL (MCX+102,MCY+89),"なし  あ り",1,.5!,4:LINE (MCX+99,MCY+99)-(MCX+99,MCY+119),PSET,7
4030 GOSUB *MOUSE_GET:IF A=0 AND MMY<100 THEN 4030 ELSE IF MMX<99 OR A=24 THEN *MENU_IN
4040 IF A=0 THEN MABP=SGN((MMX-100)\33)+1:GOSUB 4080:CCOL=(MMX\166)*OCOL
4050 TY=1:DFO=1:MID=0:SZOMX=100/MABP:SZOMY=100/MABP:R1=50:R2=50:NOU=1:XST=0:YST=0:XEN=207:YEN=289:SCM=0:LUM=0:OCM=128:FPAL=1:PALM=0:IF MABP<2 THEN XEN=423:YEN=579:FPAL=0
4060 MOUSE 5:GOSUB *READ:IF DUM<>0 THEN 4070 ELSE LOCATE 0,24:COLOR 4:PRINT "パターン読込中...";:GET@ (60,0)-(639,423),G%,4,5,6,7:LOCATE 0,24:PRINT "ディスクにデータを退避しています。";:COLOR 7:ON ERROR GOTO *PREV_ERR:KILL FDPF$:SAVE@ FDPF$,G%
4070 ON ERROR GOTO 0:MABP=1:GOSUB 4080:CLS 4:GOSUB *SCREEN_MODE:GOTO *MENU
4080 SWAP TY,OTY:SWAP CCOL,OCOL:SWAP DFO,ODFO:SWAP MID,OMID:SWAP SZOMX,OZMX:SWAP SZOMY,OZMY:SWAP R1,OOR1:SWAP R2,OOR2:SWAP NOU,ONOU:SWAP XST,OXST:SWAP YST,OYST:SWAP XEN,OXEN:SWAP YEN,OYEN:SWAP SCM,OSCM:SWAP LUM,OLUM:SWAP OCM,OOCM:SWAP FPAL,OFPAL
4090 SWAP PALM,OPALM:RETURN
4100 *PREV_ERR:IF ERR=63 THEN RESUME NEXT
4110 COLOR 2:LOCATE 0,24:BEEP:PRINT "ディスクアクセスエラー発生";:COLOR 7:WAIT 200:RESUME 4070
4200 *READ_S:SYMBOL (MCX+4,MCY+22),"  読込を実行します。",1,1,4:SYMBOL (MCX+6,MCY+101),"    取消        実行",1,1,4:LINE (MCX+1,MCY+99)-(MCX+198,MCY+99),PSET,7:LINE (MCX+99,MCY+99)-(MCX+99,MCY+119),PSET,7
4210 GOSUB *MOUSE_GET:IF A=13 THEN 4230 ELSE IF A=24 THEN *MENU_IN
4220 IF MMY<100 THEN 4210 ELSE IF MMX<99 THEN *MENU_IN
4230 MOUSE 5:GOSUB *PALETTE_UNDO:GOSUB *READ:IF DUM<>0 THEN *MENU ELSE IF PSCM<>2 THEN COLOR 4:LOCATE 0,24:PRINT "ディスクにデータを退避しています。";:COLOR 7
4240 ON ERROR GOTO *SCAN_ERR:KILL FDSF$:ON ERROR GOTO 0:GOSUB *GSAVE_SUB:PS$=FDSF$:IF PSCM<>2 THEN CLS 4
4260 GOTO *MENU
4300 *SCAN_ERR:IF ERR=63 THEN RESUME NEXT
4310 COLOR 2:BEEP:LOCATE 0,24:PRINT "ディスクアクセスエラー発生";:COLOR 7:WAIT 300:PS$=FDSF$:RESUME 4260
4500 *PARA:RADBUT=2:RCMD=1:RWFLG=0:WC$="*.SPF":FDM$="操作を選んで､.SPFファイルの名前､格納位置を指定してください｡":TM$="パラメータファイル":RADBUT$(0)=" ロード":RADBUT$(1)=" セーブ":RETFLG(0)=1:RETFLG(1)=1
4510 *PARA_LOOP:GOSUB *FILE_DIALOG:IF FDFLG<>2 THEN IF SCSI<>1 THEN CALLM RINIT&:CALLM RCLOSE&
4520 IF FDFLG=0 THEN *MENU_IN ELSE IF FDFLG=2 THEN RWFLG=RCMD-1:RIFLG=2:GOTO *PARA_LOOP
4530 IF RIGHT$(PATH$,1)<>"\" THEN PATH$=PATH$+"\"
4540 DPD$=DRIVE$:DPF$=F_NAME$:LSF=RCMD-1
4550 IF INSTR(DPF$,".")=0 THEN DPF$=LEFT$(DPF$,8)+".SPF":GOTO *GETFILE_END
4560 A=INSTR(DPF$,"."):IF LEN(DPF$)-A>3 OR A<2 THEN BEEP:FDFLG=0:GOTO *MENU_IN
4570 IF MID$(DPF$,A,4)<>".SPF" THEN DPF$=LEFT$(DPF$,A-1)+".SPF"
4580 *GETFILE_END:DPF$=PATH$+DPF$
4590 IF LSF=1 THEN 4650
4600 LOCATE 0,0:ON ERROR GOTO 5000:OPEN "I",#1,DPD$+DPF$:ID$=INPUT$(4,1):IF LEFT$(ID$,3)<>"SPF" THEN 4630 ELSE TY=FND(1):CCOL=FND(1):DFO=FND(1):MID=FND(1):SZOMX=FND(1):SZOMY=FND(1):R1=FND(1):R2=FND(1):OCM=FND(1):NOU=FND(1):LUM=FND(1):FPAL=FND(1)
4610 XST=FND(1):YST=FND(1):XEN=FND(1):YEN=FND(1):PALM=FND(1):SCM=FND(1):DSCM=FND(1):SAF=FND(1):FCX=FND(1):FCY=FND(1):XLEN=FND(1):YLEN=FND(1):DFD$=INPUT$(2,1):DFF$=FND$(1):DPD$=INPUT$(2,1):DPF$=FND$(1)
4611 IF PALM<>0 THEN GOSUB *PARAPALL
4612 SCRLM=0:ZMFV=0:IF ID$="SPF1" THEN *GETPARA_SKIP
4613 SCRLM=ASC(INPUT$(1,1)):ZMFV=ASC(INPUT$(1,1))
4630 *GETPARA_SKIP:CLOSE:GOSUB *SCREEN_CALC2:ON ERROR GOTO 0:GOTO *MENU_IN
4640 ON ERROR GOTO 0:LINE (MCX+4,MCY+24)-(MCX+195,MCY+43),PSET,1,BF:LINE (MCX+99,MCY+99)-(MCX+199,MCY+119),XOR,1,BF,4:MOUSE 4,MCX,MCY,MCX+199,MCY+119:GOTO 4530
4650 LOCATE 0,0:ON ERROR GOTO 5000:OPEN "O",#1,DPD$+DPF$:PRINT #1,"SPF2"+MKI$(TY)+MKI$(CCOL)+MKI$(DFO)+MKI$(MID)+MKI$(SZOMX)+MKI$(SZOMY)+MKI$(R1)+MKI$(R2)+MKI$(OCM)+MKI$(NOU)+MKI$(LUM)+MKI$(FPAL);
4660 PRINT #1,MKI$(XST)+MKI$(YST)+MKI$(XEN)+MKI$(YEN)+MKI$(PALM)+MKI$(SCM)+MKI$(DSCM)+MKI$(SAF)+MKI$(FCX)+MKI$(FCY)+MKI$(XLEN)+MKI$(YLEN)+DFD$+FNL$(DFF$)+DPD$+FNL$(DPF$);
4665 IF PALM<>0 THEN GOSUB *PARAPALS
4670 PRINT #1,CHR$(SCRLM)+CHR$(ZMFV);
4680 CLOSE:ON ERROR GOTO 0:GOTO *MENU_IN
4690 *GSAVE_SUB:IF PSCM<>1 THEN GOSUB *PALETTE_CHANGE:SAVE@ FDSF$,(0,0)-(1023,511),1 ELSE SAVE@ FDSF$,(0,0)-(511,255)
4700 RETURN
4800 *PARAPALS
4810 ON SCM+1 GOTO 4830,4820,4840
4820 RETURN
4830 FOR A=0 TO 15:PRINT #1,MKL$(PAL&(A));:NEXT:RETURN
4840 FOR A=0 TO 255:PRINT #1,MKL$(PAL&(A));:NEXT:RETURN
4900 *PARAPALL
4910 ON SCM+1 GOTO 4930,4920,4940
4920 RETURN
4930 GOSUB *INI256:FOR A=0 TO 15:PAL&(A)=CVL(INPUT$(4,1)):NEXT:A&=16:RETURN
4940 FOR A=0 TO 255:PAL&(A)=CVL(INPUT$(4,1)):NEXT:A&=256:RETURN
5000 BEEP:IF ERR=64 THEN M$="同名のファイルがあります":GOSUB 5130:IF YN=0 THEN RESUME *MENU_IN ELSE KILL DPD$+DPF$:RESUME
5010 IF ERR=73 THEN M$="ディスクは書込禁止です":GOSUB 5130:IF YN=0 THEN RESUME *MENU_IN ELSE RESUME
5020 IF ERR=53 THEN M$="装置に異常が発生しました":GOSUB 5110:RESUME *MENU_IN
5025 IF ERR=54 THEN M$="データ数が足りません":GOSUB 5110:IF ERL>=4600 AND ERL<4630 THEN RESUME *GETPARA_SKIP ELSE RESUME NEXT
5030 IF ERR=55 THEN M$="ファイル記述に誤りがあります":GOSUB 5110:RESUME *MENU_IN
5040 IF ERR=60 THEN M$="入出力装置は使用不可です":GOSUB 5110:RESUME *MENU_IN
5050 IF ERR=63 THEN M$="ファイルが見つかりません":GOSUB 5110:RESUME *MENU_IN
5060 IF ERR=65 THEN M$="ディレクトリ領域がいっぱいです":GOSUB 5110:RESUME *MENU_IN
5070 IF ERR=67 THEN M$="空き領域がありません":GOSUB 5110:RESUME *MENU_IN
5080 IF ERR=71 THEN M$="ファイル構成が不正です":GOSUB 5110:RESUME *MENU_IN
5090 IF ERR=72 THEN M$="ディスク装置が使用不可です":GOSUB 5110:RESUME *MENU_IN
5100 IF ERR=75 THEN M$="アクセスが拒否されました":GOSUB 5110:RESUME *MENU_IN ELSE  M$="ｴﾗｰ ID="+FNF$(ERR)+" Line ="+FNG$(ERL):GOSUB 5110:CALLM RCLOSE&,PIT&:END
5110 GOSUB 5120:MOUSE 4,MCX+120,MCY+56,MCX+169,MCY+75:LINE (MCX+120,MCY+56)-(MCX+169,MCY+75),PSET,4,B:SYMBOL (MCX+122,MCY+58),"確認",1,1,4:GOSUB *MOUSE_GET:RETURN
5120 LINE (MCX+14,MCY+56)-(MCX+181,MCY+75),PSET,1,BF:LINE (MCX+4,MCY+24)-(MCX+195,MCY+43),PSET,2,BF,1:IF LEN(M$)<23 THEN SYMBOL (MCX+8,MCY+26),M$,1,1,4:RETURN ELSE SYMBOL (MCX+8,MCY+26),M$,.75!,1,4:RETURN
5130 GOSUB 5120:MOUSE 4,MCX+80,MCY+56,MCX+159,MCY+75:LINE (MCX+80,MCY+56)-(MCX+159,MCY+75),PSET,4,B:SYMBOL (MCX+84,MCY+58),"取消 続行",1,1,4:LINE (MCX+120,MCY+56)-(MCX+120,MCY+75),PSET,4:GOSUB *MOUSE_GET:IF A>0 THEN YN=SGN(24-A) ELSE YN=MMX\120
5140 RETURN
5150 *MODE:DFB=DFO:GOSUB *PREV_PUT:GOSUB *MENU_WRT:OSCM=SCM:SYMBOL (MCX+3,MCY+4),"取込映像上方",1,1,4:SYMBOL (MCX+39,MCY+41),"スクリーンモード",1,1,4:SYMBOL (MCX+38,MCY+101),"取消        実行",1,1,4:LINE (MCX+4,MCY+39)-(MCX+195,MCY+57),PSET,3,B
5160 LINE (MCX+1,MCY+99)-(MCX+198,MCY+99),PSET,7:LINE (MCX+116,MCY+3)-(MCX+196,MCY+39),PSET,6,BF,4:SYMBOL (MCX+120,MCY+6),"♀",2,2,2:SYMBOL (MCX+190,MCY+6),"♀",2,2,2,3:LINE (MCX+156,MCY+4)-(MCX+156,MCY+38),PSET,1
5170 LINE (MCX+4,MCY+58)-(MCX+195,MCY+76),PSET,6,BF,4:LINE (MCX+2,MCY+3)-(MCX+115,MCY+21),PSET,3,B:LINE (MCX+20,MCY+58)-(MCX+179,MCY+76),PSET,6,BF,0:LINE (MCX+99,MCY+99)-(MCX+99,MCY+119),PSET,7:LINE (MCX+115,MCY+3)-(MCX+197,MCY+39),PSET,3,B
5180 SYMBOL (MCX+5,MCY+74),"▲",1,1,2,1:SYMBOL (MCX+194,MCY+60),"▲",1,1,2,3:ODSCM=DSCM:OTY=TY:GOSUB 5280
5190 LINE (MCX+21,MCY+59)-(MCX+178,MCY+75),PSET,0,BF:SYMBOL (MCX+24,MCY+59),SCM$(DSCM),1,1,4:GOSUB *MOUSE_GET
5200 IF A>0 THEN IF A=24 THEN MMX=50:MMY=100 ELSE 5290
5210 IF MMY>98 THEN IF MMX<99 THEN DSCM=ODSCM:TY=OTY:GOTO *MENU_IN ELSE 5290
5220 IF (MMY<40 AND MMX<116) OR (MMY>39 AND MMY<58) OR MMY>76 THEN 5190
5230 IF MMY>57 AND MMX>20 AND MMX<179 THEN 5190
5240 IF MMY<40 THEN GOSUB 5280:IF MMX<156 THEN TY=1:GOSUB 5280:GOTO 5190 ELSE TY=0:GOSUB 5280:GOTO 5190
5250 IF MMX<21 THEN DSCM=DSCM-1:IF DSCM<0 THEN DSCM=3
5260 IF MMX>178 THEN DSCM=DSCM+1:IF DSCM>3 THEN DSCM=0
5270 GOTO 5190
5280 A=MCX+116+TY*41:LINE (A,MCY+4)-(A+39,MCY+38),XOR,1,BF:RETURN
5290 IF OTY<>TY THEN SWAP XEN,YEN:XEN=((XEN+1)\8)*8-1 ELSE 5330
5300 MAX=8*(INT((8.56!*R1*SZOMX/100)/8)):MAY=INT(11.6!*R2*SZOMY/100)
5310 IF XST+XEN>MAX THEN IF XST>0 THEN XST=XST-1:GOTO 5310 ELSE XEN=(((XEN+1)-8)\8)*8-1:GOTO 5310
5320 IF YST+YEN>MAY THEN IF YST>0 THEN YST=YST-1:GOTO 5320 ELSE YEN=YEN-1:GOTO 5320
5330 IF DSCM=0 THEN DFO=1:SCM=DSCM
5340 IF DSCM=1 THEN DFO=5:SCM=DSCM:PALM=0
5350 IF DSCM=2 THEN DFO=2:SCM=DSCM
5360 IF DSCM=3 THEN DFO=3:SCM=2
5370 IF SCM<>OSCM THEN GOSUB *PALETTE_PALETTE_IN:PALM=0:FPAL=0:DFB=DFO:SCRLM=0
5380 GOSUB *SCREEN_CALC:IF TY THEN BDM=BDY:BDS=BDX ELSE BDM=BDX:BDS=BDY
5390 IF XEN>BDM THEN XEN=BDM
5400 IF YEN>BDS THEN YEN=BDS
5410 DFO=DFB:GOTO *MENU_IN
5420 *IMAGE:SYMBOL (MCX+3,MCY+4),"色指定",1,1,4:SYMBOL (MCX+3,MCY+24)," 明度",1,1,4:SYMBOL (MCX+3,MCY+44),"濃度補正",.75!,1,4:SYMBOL (MCX+3,MCY+64),"中間調",1,1,4:SYMBOL (MCX+3,MCY+84),"色補正",1,1,4:LINE (MCX+51,MCY+2)-(MCX+51,MCY+100),PSET,3
5430 FOR W=1 TO 4:A=MCY+2+20*W:LINE (MCX+2,A)-(MCX+198,A),PSET,3:NEXT:SYMBOL (MCX+38,MCY+105),"取消        実行",1,.8!,4:LINE (MCX+1,MCY+103)-(MCX+198,MCY+103),PSET,7:LINE (MCX+99,MCY+103)-(MCX+99,MCY+119),PSET,7
5440 FOR W=0 TO 4:A=MCY+3+20*W:LINE (MCX+52,A)-(MCX+197,A+18),PSET,6,BF,4:NEXT:FOR W=0 TO 4:A=MCY+3+20*W:LINE (MCX+62,A)-(MCX+187,A+18),PSET,6,BF,0:NEXT:LINE (MCX+2,MCY+2)-(MCX+198,MCY+102),PSET,3,B
5450 SYMBOL (MCX+54,MCY+99),"▲▲▲▲▲",1,.5!,2,1,,,4:SYMBOL (MCX+195,MCY+5),"▲▲▲▲▲",1,.5!,2,3,,,4
5460 CLP=0:FOR A=0 TO 5:IF COL%(A)=CCOL THEN CLP=A:NEXT ELSE NEXT
5470 LUMP=0:FOR A=0 TO 6:IF LUM%(A)=LUM THEN LUMP=A:NEXT ELSE NEXT
5480 NOUP=0:FOR A=0 TO 4:IF NOU%(A)=NOU THEN NOUP=A:NEXT ELSE NEXT
5490 MIDP=0:FOR A=0 TO 3:IF MID%(A)=MID THEN MIDP=A:NEXT ELSE NEXT
5500 OCMP=0:FOR A=0 TO 3:IF OCM%(A)=OCM THEN OCMP=A:NEXT ELSE NEXT
5510 CMD=0:PX!=1:PCX=16:M$=COL$(CLP):GOSUB 5640:CMD=1:PX!=1:PCX=0:M$=LUM$(LUMP):GOSUB 5640:CMD=2:PX!=.9!:PCX=0:M$=NOU$(NOUP):GOSUB 5640:CMD=3:PX!=1:PCX=8:M$=MIDL$(MIDP):GOSUB 5640:CMD=4:PX!=.9!:PCX=0:M$=OCM$(OCMP):GOSUB 5640
5520 GOSUB *MOUSE_GET:IF A>0 THEN IF A=13 THEN MMX=150:MMY=105 ELSE *MENU_IN
5530 IF MMY>103 THEN IF MMX>99 THEN CCOL=COL%(CLP):LUM=LUM%(LUMP):NOU=NOU%(NOUP):MID=MID%(MIDP):OCM=OCM%(OCMP):IF SCM=2 AND PALM=1 AND (CCOL=1 OR CCOL=2) THEN CCOL=0:GOTO *MENU_IN ELSE *MENU_IN ELSE *MENU_IN
5540 IF MMX<52 OR (MMX>62 AND MMX<187) THEN 5520
5550 IF MMY<22 THEN CMD=0:PX!=1:PCX=16:CMDP=CLP:CMDM=5:GOSUB 5610:CLP=CMDP:M$=COL$(CLP):GOTO 5600
5560 IF MMY<42 THEN CMD=1:PX!=1:PCX=0:CMDP=LUMP:CMDM=6:GOSUB 5610:LUMP=CMDP:M$=LUM$(LUMP):GOTO 5600
5570 IF MMY<62 THEN CMD=2:PX!=.9!:PCX=0:CMDP=NOUP:CMDM=4:GOSUB 5610:NOUP=CMDP:M$=NOU$(NOUP):GOTO 5600
5580 IF MMY<82 THEN CMD=3:PX!=1:PCX=8:CMDP=MIDP:CMDM=3:GOSUB 5610:MIDP=CMDP:M$=MIDL$(MIDP):GOTO 5600
5590 CMD=4:PX!=.9!:PCX=0:CMDP=OCMP:CMDM=3:GOSUB 5610:OCMP=CMDP:M$=OCM$(OCMP)
5600 GOSUB 5640:GOTO 5520
5610 IF MMX>98 THEN CMDP=CMDP+1:IF CMDP>CMDM THEN CMDP=CMDM
5620 IF MMX<99 THEN CMDP=CMDP-1:IF CMDP<0 THEN CMDP=0
5630 RETURN
5640 A=MCY+4+20*CMD:LINE (MCX+63,A)-(MCX+186,A+16),PSET,0,BF:SYMBOL (MCX+PCX+62,A),M$,PX!,1,4:RETURN
5650 GOTO 5650
5660 *PALETTE:IF SCM=1 THEN LINE (MCX+114,MCY+99)-(MCX+199,MCY+119),PSET,7,B:SYMBOL (MCX+124,MCY+101),"メニュー",1,1,4:SYMBOL (MCX+20,MCY+22),"現在の画面モードでは",1,1,4:SYMBOL (MCX+20,MCY+40),"設定できません",1,1,4:GOSUB *MOUSE_GET:GOTO *MENU_IN
5670 GOSUB *SCREEN_MODE:GOSUB *PREV_PUT_IN:LINE (60,0)-(639,423),PSET,7,B:LINE (13,435)-(226,454),PSET,6,BF,4:LINE (229,435)-(402,454),PSET,6,BF,4:LINE (30,435)-(209,454),PSET,6,BF,0:LINE (246,435)-(385,454),PSET,6,BF,0:LOCATE 52,23:COLOR (SCM+1)*2
5680 PRINT "メニュー  取り込み  初期化";:LINE (412,435)-(483,454),XOR,3,BF,4:LINE (492,435)-(563,454),XOR,3,BF,4:LINE (572,435)-(627,454),XOR,3,BF,4:MOUSE 0:MOUSE 1,320,240,1:GOSUB 6280:COLOR 4:LOCATE 31,23:PRINT "固定パレット";:COLOR 6:LOCATE 2,24
5690 PRINT "Palette Mode";:LINE (13,455)-(115,472),XOR,2,BF,1:LINE (115,455)-(146,472),PSET,2,BF,0:SYMBOL (14,452),"▲",1,1,2,1:SYMBOL (210,452),"▼",1,1,2,1:SYMBOL (230,452),"▲",1,1,2,1:SYMBOL (386,452),"▼",1,1,2,1:COLOR 6:GOSUB *PALETTE_CHANGE
5700 IF SCM=2 THEN *PALETTE_256
5710 *PALETTE_16:MPAL=16:FOR A=0 TO 15:LINE (10,A*19+10)-(49,A*19+30),PSET,7,BF,%A:NEXT:PAL1=PALM-1:PAL2=FPAL:GOSUB 6080:GOSUB 6100:PALX=0:PALY=0:PALL=16:GOSUB 6130
5720 GOSUB 5850:IF CMD=1 THEN FPAL=PAL2:LINE (0,0)-(59,479),PSET,0,BF:LINE (0,424)-(639,479),PSET,0,BF:CLS 4:GOSUB 6130:FPAL=PAL2:DFO=PALM*3+1:IF DFO=4 THEN CCOL=2:GOTO *MENU ELSE *MENU
5730 IF CMD=3 THEN GOSUB 6100:GOSUB 6080:GOSUB 5840:GOTO 5720 ELSE LGP2=16:IF PAL2=16 THEN BEEP:GOTO 5720 ELSE LGP=8:LGP3=4:LGP4=16-PAL2:GOSUB 5780:PALM=1:GOSUB 6080:GOTO 5720
5740 *PALETTE_256:MPAL=256:MOUSE 1,,,0:FOR A=0 TO 15:FOR B=0 TO 15:LINE (B*3,A*3)-(B*3+2,A*3+2),PSET,%(A*16+B),BF:NEXT:NEXT:MOUSE 1,,,1:PAL1=PALM-1:PAL2=FPAL:GOSUB 6080:GOSUB 6100:PALX=0:PALY=0:PALL=64:GOSUB 6130
5750 GOSUB 5850:IF CMD<>1 THEN 5770 ELSE PALM=PAL1+1:LINE (0,0)-(59,479),PSET,0,BF:LINE (0,424)-(639,479),PSET,0,BF:GOSUB 6130:IF PAL1>=0 THEN DFO=8-(PAL1 MOD 2)*4 ELSE DFO=DSCM
5760 IF PAL1<>0 THEN FPAL=0:CCOL=2:GOTO *MENU ELSE FPAL=PAL2 MOD 3:GOSUB *PALETTE_SET:IF CCOL<3 THEN CCOL=0:GOTO *MENU ELSE *MENU
5770 IF CMD=3 THEN GOSUB 6100:GOSUB 6080:GOSUB 5840:GOTO 5750 ELSE LGP2=64:IF PAL1<1 OR PAL2=256 THEN BEEP:GOTO 5750 ELSE LGP=32*PAL1:LGP3=4*PAL1:LGP4=256-PAL2:GOSUB 5780:GOTO 5750
5780 LINE (148,455)-(331,472),PSET,0,BF:LOCATE 20,24:PRINT "スキャナ読み込み中…   ";:PIT&=CALLM(RINIT&):SCOM$="C":PAR$=CHR$(2):GOSUB *SENDDATA2C:SCOM$="D":SWAP LGP3,DFO:GOSUB *DEPTH_SET:SWAP LGP3,DFO:GOSUB *SENDDATA2
5790 SCOM$="H":PAR$=CHR$(100,100):GOSUB *SENDDATA2:SCOM$="M":PAR$=CHR$(OCM):GOSUB *SENDDATA2:SCOM$="L":PAR$=CHR$(LUM):GOSUB *SENDDATA2:SCOM$="Z":PAR$=CHR$(NOU):GOSUB *SENDDATA2:SCOM$="R":PAR$=CHR$(50,0,50,0):GOSUB *SENDDATA2
5800 SCOM$="A":PAR$=CHR$(PALY MOD 256,PALY \ 256,PALX MOD 256,PALX \ 256,PALL,0,PALL,0):GOSUB *SENDDATA2:A&=1
5810 FOR L=0 TO LGP2-1:FOR COL=0 TO 2
5820 A&=CALLM(GETH&,VARPTR(GD%(0))+LGP*COL,A&):IF A&=ERRC& THEN *ERR2
5830 NEXT:CALLM OFR,LGP,0,VARPTR(GD%(0)),VARPTR(G%(L*2*LGP2)):NEXT:CALLM RCLOSE&,PIT&:LOCATE 20,24:PRINT "パレットデータ作成中… ";:A&=CALLM(OFR,LGP,LGP4,0,VARPTR(G%(0)),VARPTR(PAL&(0))):GOSUB *PALETTE_CHANGE
5840 LOCATE 20,24:PRINT "定義済パレット数 :";FNF$(MPAL-A&);" ";:LINE (148,455)-(331,472),PSET,6,B:RETURN
5850 WHILE MOUSE(2,0)=0:WEND:MMX=MOUSE(0):MMY=MOUSE(1):IF MMX<640-PALX AND MMY=>PALY AND MMX>639-PALX-PALL AND MMY<PALY+PALL THEN GOSUB 6270:GOTO 5850
5860 WHILE MOUSE(6,0)=0:A=MOUSE(2,1):WEND:MMX=MOUSE(0):MMY=MOUSE(1):IF MMY<435 THEN 5930 ELSE IF MMY>454 THEN 5850 ELSE IF MMX>411 THEN 6140
5870 IF MMX<31 AND SCM=2 THEN PAL1=PAL1-1:IF PAL1<0 THEN PAL1=2
5880 IF MMX>208 AND MMX<227 AND SCM=2 THEN PAL1=PAL1+1:IF PAL1>2 THEN PAL1=0
5890 IF MMX>228 AND MMX<247 THEN PAL2=PAL2-1+A*3.5!:IF PAL2<0 THEN IF A THEN PAL2=0 ELSE PAL2=MPAL
5900 IF MMX>384 AND MMX<403 THEN PAL2=PAL2+1-A*3.5!:IF PAL2>MPAL THEN IF A THEN PAL2=MPAL ELSE PAL2=0
5910 IF MMX>246 AND MMX<385 THEN PAL2=MPAL-A&
5920 GOSUB 6100:GOSUB 6080:GOTO 5850
5930 IF SCM=2 THEN 5850 ELSE IF MMX>9 AND MMX<49 AND MMY>9 AND MMY<314 THEN COLOR 7 ELSE 5850
5940 PCY=(MMY-10)\19:GET@A (50,PCY*19+5)-(259,PCY*19+124),G%:LINE (76,PCY*19+5)-(259,PCY*19+124),PSET,7,BF,1:CONNECT (76,PCY*19+12)-(50,PCY*19+17)-(76,PCY*19+22),7,PSET,F,1:LOCATE 30,PCY+1:PRINT "□":PRINT SPC(10);"パレット修正"
5950 PRINT SPC(10);"G ＜";SPC(16);"＞":PRINT SPC(10);"R ＜";SPC(16);"＞":PRINT SPC(10);"B ＜";SPC(16);"＞":FOR A=0 TO 2:GOSUB 6040:NEXT:FOR A=3 TO 5:LINE (76,(PCY+A)*19-2)-(259,(PCY+A)*19+17),PSET,7,B:LINE(89,(PCY+A)*19-2)-(111,(PCY+A)*19+17),PSET,7,B
5960 LINE (239,(PCY+A)*19-2)-(239,(PCY+A)*19+17),PSET,7,B:NEXT:LINE (240,PCY*19+19)-(254,PCY*19+34),PSET,7:LINE (254,PCY*19+19)-(240,PCY*19+34),PSET,7:LINE (80,PCY*19+9)-(119,PCY*19+28),PSET,7,BF,%PCY:MOUSE 4,76,PCY*19+5,259,PCY*19+124
5970 WHILE MOUSE(2,0)=0:WEND:MMX=MOUSE(0):MMY=MOUSE(1):IF MMX>239 AND MMY>PCY*19+18 AND MMX<255 AND MMY<PCY*19+35 THEN WHILE MOUSE(6,0)=0:WEND:PUT@A (50,PCY*19+5)-(259,PCY*19+124),G%:GOSUB 6280:FOR A=0 TO 5:LOCATE 0,PCY+A:PRINT SPC(40);:NEXT:GOTO 5850
5980 IF MMX<76 OR MMX>259 OR MMY<(PCY+3)*19-2 OR MMY>(PCY+5)*19+17 THEN 5970 ELSE A=(MMY-PCY*19+2)\19-3:IF MMX<111 OR MMX>239 THEN GOSUB 6000:GOTO 5970
5990 B=(MMX-111)\8:GOSUB 6010:GOTO 5970
6000 GOSUB 6050:WHILE MOUSE(6,0)=0:WEND:BB=B:B=B+SGN(MMX-150):IF B>15 OR B<0 THEN B=BB
6010 ON A GOTO 6020,6030:PAL&(PCY)=(PAL&(PCY) AND 65535)+B*1048576:GOTO 6040
6020 PAL&(PCY)=(PAL&(PCY) AND 16711935)+B*4096:GOTO 6040
6030 PAL&(PCY)=(PAL&(PCY) AND 16776960)+B*16
6040 PALETTE PCY,[(PAL&(PCY) AND 16711680)\65536,(PAL&(PCY) AND 65280)\256,PAL&(PCY) AND 255]
6050 ON A GOTO 6060,6070:B=(PAL&(PCY) AND 16711680)\1048576:A$=SPACE$(16):MID$(A$,B+1)="|":LOCATE 14,PCY+3:PRINT A$:RETURN
6060 B=(PAL&(PCY) AND 65280)\4096:A$=SPACE$(16):MID$(A$,B+1)="|":LOCATE 14,PCY+4:PRINT A$:RETURN
6070 B=(PAL&(PCY) AND 255)\16:A$=SPACE$(16):MID$(A$,B+1)="|":LOCATE 14,PCY+5:PRINT A$:RETURN
6080 LOCATE 15,24:IF (SCM=2 AND PAL1<0) OR (SCM=0 AND PALM=0) THEN PRINT "OFF"; ELSE PRINT "ON ";
6090 LINE (13,455)-(146,472),PSET,2,B:RETURN
6100 LOCATE 43,23:COLOR 4:GOSUB 6110:LINE (246,454)-(385,454),PSET,6:LOCATE 4,23:IF SCM=0 OR PAL1=-1 THEN PRINT SPC(22);:LINE (30,454)-(209,454),PSET,6,BF,%7:COLOR 6:RETURN ELSE PRINT PAL$(PAL1);:COLOR 6:LINE (30,454)-(209,454),PSET,6:RETURN
6110 IF PAL1=0 AND SCM=2 THEN IF (PAL2 MOD 3)=0 THEN PRINT " 無し";:RETURN ELSE PRINT FNF$((PAL2 MOD 3)*8)+"色";:RETURN
6120 IF PAL2=0 THEN PRINT " 無し";:RETURN ELSE PRINT FNF$(PAL2)+"色";:RETURN
6130 LINE (639-PALX,PALY)-(640-PALX-PALL,PALY+PALL-1),XOR,7,B:RETURN
6140 CMD=0:IF MMX>411 AND MMX<484 THEN CMD=1 ELSE IF MMX>491 AND MMX<564 THEN CMD=2 ELSE IF MMX>571 AND MMX<628 THEN CMD=3
6150 IF CMD=0 THEN 5850 ELSE PCX=CMD*80+280:IF CMD=3 THEN 6180 ELSE GET@A (PCX,416)-(PCX+109,436),G%:LINE (PCX,416)-(PCX+109,436),PSET,3,BF,4:SYMBOL (PCX+12,418),"取消   実行",1,1,2,,,5:LINE (PCX+56,416)-(PCX+56,436),PSET,3
6160 MOUSE 1,PCX+30,425,1:MOUSE 4,PCX,416,PCX+109,436:GOSUB *MOUSE_GET:MMX=MMX+MCX:IF A>0 THEN MMX=60*SGN(24-A)+PCX
6170 GOSUB 6280:PUT@A (PCX,416)-(PCX+109,436),G%,PSET:MMX=MMX-PCX:IF MMX<56 THEN 5850 ELSE RETURN
6180 GET@A (PCX,332)-(PCX+109,437),G%:LINE (PCX,332)-(PCX+109,437),PSET,3,BF,4:RESTORE 6260:FOR A=0 TO 5:READ M$:IF PSCM=0 AND A=4 THEN M$="――――――"
6190 SYMBOL (PCX+4,334+17*A),M$,1,1,2,,,5:NEXT:MOUSE 1,PCX+30,425,1:MOUSE 4,PCX,334,PCX+109,435:CMD=9
6200 MMY=MOUSE(1):IF INKEY$=CHR$(24) THEN 6253 ELSE OCMD=CMD:CMD=(MMY-334)\17
6210 IF CMD<>OCMD THEN LINE (PCX,334+17*OCMD)-(PCX+109,349+17*OCMD),XOR,4,BF:LINE (PCX,334+17*CMD)-(PCX+109,349+17*CMD),XOR,4,BF
6220 IF MOUSE(2,0)=0 THEN 6200 ELSE WHILE MOUSE(6,0)=0:WEND:IF CMD=5 THEN 6253 ELSE IF CMD=4 THEN IF PSCM=0 THEN 6253 ELSE PAL1=0
6230 GOSUB *PALETTE_FIX:IF CMD=0 THEN IF PSCM=0 THEN PALM=0 ELSE PAL1=-1
6240 IF CMD>1 AND CMD<4 THEN IF PSCM=0 THEN PALM=1 ELSE IF PAL1<2 THEN PAL1=2
6250 PUT@A (PCX,332)-(PCX+109,437),G%,PSET:GOSUB 6280:CMD=3:RETURN
6253 IF PSCM=0 THEN A&=16 ELSE IF PSCM=2 THEN A&=256
6255 GOTO 6250
6260 DATA "Towns System","MaskT_Paint","Rainbow","ColofulStick","GrayScale"," 取 消 "
6270 GOSUB 6130:MMX=639-PALX:MMY=PALY+PALL-1:MOUSE 1,MMX,MMY,1:MOUSE 4,59+PALL,PALL-1,639,423:WHILE MOUSE(6,0)=0:PALX=639-MOUSE(0):PALY=MOUSE(1)-PALL+1:GOSUB 6130:GOSUB 6130:WEND:GOSUB 6130
6280 MOUSE 4,0,0,639,454:RETURN
6290 *ZOOM:SYMBOL (MCX+3,MCY+4),"解像度",1,1,4:SYMBOL (MCX+3,MCY+38),"倍率",1,1,4:SYMBOL (MCX+52,MCY+4),"主",1,1,3:SYMBOL (MCX+52,MCY+21),"副",1,1,3:SYMBOL (MCX+52,MCY+38),"主",1,1,3:SYMBOL (MCX+52,MCY+55),"副",1,1,3
6300 LINE (MCX+74,MCY+2)-(MCX+189,MCY+71),PSET,3,BF,4:LINE (MCX+90,MCY+2)-(MCX+173,MCY+71),PSET,3,BF,6:LINE (MCX+106,MCY+2)-(MCX+157,MCY+71),PSET,3,BF,0:LINE (MCX+90,MCY+20)-(MCX+173,MCY+54),PSET,3,B:LINE (MCX+74,MCY+37)-(MCX+189,MCY+37),PSET,3:GOSUB 6580
6310 SYMBOL (MCX+77,MCY+68),"▲▲",2,.7!,2,1,,,2:SYMBOL (MCX+186,MCY+5),"▲▲",2,.7!,2,3,,,2:SYMBOL (MCX+93,MCY+69),"▲▲▲▲",1,.7!,2,1,,,1:SYMBOL (MCX+170,MCY+4),"▲▲▲▲",1,.7!,2,3,,,1:SYMBOL (MCX+3,MCY+76),"↑主        ％",1,1,4,,,8
6320 SYMBOL (MCX+3,MCY+94),"←副",1,1,4,,,8:LINE (MCX,MCY+73)-(MCX+199,MCY+73),PSET,7:LINE (MCX+90,MCY+73)-(MCX+90,MCY+119),PSET,7:SYMBOL (MCX+92,MCY+91),"Zoom",.75!,.5!,5,,,8:SYMBOL (MCX+4,MCY+110),"Screen",.75!,.5!,5,,,8
6330 OZMX=SZOMX:OZMY=SZOMY:SYMBOL (MCX+102,MCY+101),"取消   実行",1,1,4:LINE (MCX+90,MCY+99)-(MCX+199,MCY+99),PSET,7:LINE (MCX+145,MCY+99)-(MCX+145,MCY+119),PSET,7:SYMBOL (MCX+124,MCY+75),"M     S",.8!,.5!,5:MOUSE 1,MCX+100,MCY+60,1
6340 GOSUB 6520:GOSUB 6530:GOSUB 6540:GOSUB 6550:GOSUB 6560:A=0:I=0
6350 IF MOUSE(2,0)=0 THEN I$=INKEY$:IF MOUSE(2,1) THEN SZOMX=OZMX:SZOMY=OZMY:GOTO 6340 ELSE IF I$=CHR$(13) OR I$=CHR$(24) THEN I=ASC(I$):MMX=100+50*SGN(24-I):GOTO 6510 ELSE 6350
6360 IF MOUSE(6,0)=0 THEN A=A+1 ELSE A=0
6370 MMX=MOUSE(0)-MCX:MMY=MOUSE(1)-MCY:IF MMY>72 THEN IF MMY<99 OR MMX<90 THEN A=0:GOTO 6350 ELSE 6510
6380 IF MMX<74 OR MMX>189 OR (MMX>106 AND MMX<157) THEN A=0:GOTO 6350
6390 ADP=SGN(MMX-120):IF A>10 THEN ADP=ADP*10
6400 IF MMY<37 THEN 6410 ELSE 6460
6410 IF MMX>90 AND MMX<173 THEN IF MMY>20 THEN GOSUB 6440:FOR W=0 TO 1000:NEXT:GOTO 6350 ELSE 6420 ELSE GOSUB 6440
6420 SR1P=R1P:R1P=R1P+SGN(ADP):IF R1P<0 OR R1P>MNDP THEN R1P=SR1P
6430 GOSUB 6520:FOR W=0 TO 1000:NEXT:GOTO 6350
6440 SR2P=R2P:R2P=R2P+SGN(ADP):IF R2P<0 OR R2P>MNDP THEN R2P=SR2P
6450 GOSUB 6530:RETURN
6460 IF MMX>90 AND MMX<173 THEN IF MMY>54 THEN GOSUB 6490:GOSUB 6560:GOTO 6350 ELSE 6470 ELSE GOSUB 6490
6470 SZOMX=SZOMX+ADP:IF SZOMX<50 THEN SZOMX=50 ELSE IF SZOMX>200 THEN SZOMX=200
6480 GOSUB 6540:GOSUB 6560:GOTO 6350
6490 SZOMY=SZOMY+ADP:IF SZOMY<50 THEN SZOMY=50 ELSE IF SZOMY>200 THEN SZOMY=200
6500 GOSUB 6550:RETURN
6510 IF MMX<145 THEN SZOMX=OZMX:SZOMY=OZMY:GOTO *MENU_IN ELSE R1=DPI%(R1P):R2=DPI%(R2P):GOTO *MENU_IN
6520 LINE (MCX+120,MCY+3)-(MCX+143,MCY+18),PSET,0,BF:SYMBOL (MCX+120,MCY+3),FNF$(DPI%(R1P)),1,1,4:GOSUB 6560:RETURN
6530 LINE (MCX+120,MCY+21)-(MCX+143,MCY+35),PSET,0,BF:SYMBOL (MCX+120,MCY+21),FNF$(DPI%(R2P)),1,1,4:GOSUB 6560:RETURN
6540 LINE (MCX+120,MCY+38)-(MCX+143,MCY+53),PSET,0,BF:SYMBOL (MCX+120,MCY+38),FNF$(SZOMX),1,1,4:RETURN
6550 LINE (MCX+120,MCY+55)-(MCX+143,MCY+70),PSET,0,BF:SYMBOL (MCX+120,MCY+55),FNF$(SZOMY),1,1,4:RETURN
6560 LINE (MCX+46,MCY+76)-(MCX+86,MCY+116),PSET,1,BF:RHI!=(SZOMY/SZOMX)*(DPI%(R2P)/DPI%(R1P)):IF RHI!>1 THEN RLN!=20/RHI! ELSE RLN!=20
6570 CIRCLE (MCX+66,MCY+96),RLN!,4,RHI!:LINE (MCX+128,MCY+83)-(MCX+197,MCY+98),PSET,1,BF:SYMBOL (MCX+130,MCY+83),FNF$(INT(SZOMX/OZMX*100))+"  "+FNF$(INT(SZOMY/OZMY*100)),1,1,4:RETURN
6580 R1P=0:FOR A=0 TO MNDP:IF DPI%(A)=R1 THEN R1P=A:NEXT ELSE NEXT
6590 R2P=0:FOR A=0 TO MNDP:IF DPI%(A)=R2 THEN R2P=A:NEXT ELSE NEXT
6600 RETURN
6610 *AREA:GOSUB *PREV_PUT:LINE (60,0)-(639,423),PSET,7,B:LINE (504,428)-(599,449),PSET,%8,BF,%7:SYMBOL (504,430)," 取消  実行 ",1,1,4:LINE (551,428)-(551,449),PSET,%8
6620 LINE (0,0)-(58,423),PSET,%7,BF,%1:LINE (6,10)-(52,18),PSET,7,B:SYMBOL (4,30),"ｽｷｬﾅ読取",.75!,1,5:SYMBOL (4,46),"可能領域",.75!,1,5:LINE (6,70)-(52,78),PSET,7,B,&H3333:SYMBOL (4,90),"読取",.75!,1,5:SYMBOL (4,106),"指定領域",.75!,1,5:COLOR 6
6630 RSM!=(100/SZOMX)*(50/R1):RSS!=(100/SZOMY)*(50/R2):LINE (6,435)-(482,454),PSET,3,BF,%1:SYMBOL (36,76),"xor",.75!,1,4,,,,1:OXST=XST:OYST=YST:OXEN=XEN:OYEN=YEN:IF TY THEN DI$="  ↑":BDM=BDY+1:BDS=BDX+1 ELSE DI$="  →":BDM=BDX+1:BDS=BDY+1
6640 LINE (6,457)-(625,476),PSET,2,BF,%1:SYMBOL (16,459),"解像度(dpi)  主: "+FNF$(R1)+" 副: "+FNF$(R2)+"   倍率(%)  主: "+FNF$(SZOMX)+" 副: "+FNF$(SZOMY)+"   映像上方:"+DI$,1,1,5:MAX=8*(INT((8.56!*R1*SZOMX/100)/8))-1:MAY=INT(11.6!*R2*SZOMY/100)-1
6650 A&=FRE(4):IF XST+XEN>MAX THEN IF XST>0 THEN XST=XST-1:GOTO 6650 ELSE XEN=(((XEN+1)-8)\8)*8-1:GOTO 6650
6660 IF YST+YEN>MAY THEN IF YST>0 THEN YST=YST-1:GOTO 6660 ELSE YEN=YEN-1:GOTO 6660
6670 ASM=XST*RSM!:ARM=(XEN+1)*RSM!+ASM-1:ASS=YST*RSS!:ARS=639-((YEN+1)*RSS!+ASS-1):ASS=639-ASS
6680 IF ARM>423 THEN IF XST>0 THEN XST=XST-1:GOTO 6670 ELSE XEN=(((XEN+1)-8)\8)*8-1:GOTO 6670
6690 IF ASS<60 THEN IF YST>0 THEN YST=YST-1:GOTO 6670 ELSE YEN=YEN-1:GOTO 6670
6700 GOSUB 7010
6710 GOSUB 7250:MOUSE 4,60,0,639,449:MOUSE 1,FNM(ARS,ASS),FNM(ASM,ARM),1:GOTO 6730
6720 IF MOUSE(2,1) THEN GOSUB 7240:WHILE MOUSE(6,1)=0:WEND:XST=OOXST:YST=OOYST:XEN=OOXEN:YEN=OOYEN:ASS=OASS:ASM=OASM:ARS=OARS:ARM=OARM:GOSUB 7250
6730 I=0:LINE (ASS,ASM)-(ARS,ARM),XOR,7,B,&H0F0F:LINE (ASS,ASM)-(ARS,ARM),XOR,7,B:IF MOUSE(2,0) THEN A=MOUSE(6,0):OOXST=XST:OOYST=YST:OOXEN=XEN:OOYEN=YEN:OASS=ASS:OASM=ASM:OARS=ARS:OARM=ARM ELSE I$=INKEY$:IF I$="" THEN 6720 ELSE I=ASC(I$)
6740 GOSUB 7240:IF I>0 THEN MMX=510+50*SGN(24-I):GOTO 7220
6750 MMX=MOUSE(0):MMY=MOUSE(1):IF MMX>504 AND MMY>428 AND MMX<599 AND MMY<449 THEN 7220 ELSE IF MMX>ASS+DI OR MMX<ARS-DI OR MMY<ASM-DI OR MMY>ARM+DI THEN 6720 ELSE CMD=0
6760 IF MMX>ASS-DI THEN CMD=1:GOTO 6780
6770 IF MMX<ARS+DI THEN CMD=4
6780 IF MMY<ASM+DI THEN CMD=CMD+8:GOTO 6800
6790 IF MMY>ARM-DI THEN CMD=CMD+2
6800 IF CMD=0 THEN 7160 ELSE LNX=60:LNY=0:CPX=639:CPY=423
6810 IF CMD AND 1 THEN MMX=ASS:LNX=ARS:CPX=639:IF BDS*RSS!<CPX-LNX THEN CPX=BDS*RSS!+LNX
6820 IF CMD AND 2 THEN MMY=ARM:LNY=ASM:CPY=423:IF BDM*RSM!<CPY-LNY THEN CPY=BDM*RSM!+LNY
6830 IF CMD AND 4 THEN MMX=ARS:LNX=60:CPX=ASS:IF BDS*RSS!<CPX-LNX THEN LNX=CPX-BDS*RSS!
6840 IF CMD AND 8 THEN MMY=ASM:LNY=0:CPY=ARM:IF BDM*RSM!<CPY-LNY THEN LNY=CPY-BDM*RSM!
6850 MOUSE 4,LNX,LNY,CPX,CPY:MOUSE 1,MMX,MMY,0
6860 MMX=MOUSE(0):MMY=MOUSE(1):ON CMD GOSUB 6880,6900,6890,6920,20,6910,20,6940,6930,20,20,6950:LINE (ASS,ASM)-(ARS,ARM),XOR,7,B:LINE (ASS,ASM)-(ARS,ARM),XOR,7,B:GOSUB 6960:GOSUB 7010
6870 IF MOUSE(6,0)<>0 THEN GOSUB 6960:GOTO 6650 ELSE IF MOUSE(2,1) THEN 7020 ELSE 6860
6880 ASS=MMX:RETURN
6890 GOSUB 6880
6900 ARM=MMY:RETURN
6910 GOSUB 6900
6920 ARS=MMX:RETURN
6930 GOSUB 6880
6940 ASM=MMY:RETURN
6950 GOSUB 6920:GOTO 6940
6960 LNX=639-ASS:LNY=ASM:XST=LNY/RSM!:YST=LNX/RSS!:LNX=ASS-ARS:LNY=ARM-ASM+1:XEN=((LNY/RSM!)\8)*8-1:YEN=LNX/RSS!
6970 IF CMD MOD 3 THEN IF CMD=1 OR CMD=4 THEN XST=OOXST:XEN=OOXEN ELSE YST=OOYST:YEN=OOYEN
6980 IF XEN<7 THEN XEN=7 ELSE IF XEN>=BDM THEN XEN=BDM-1
6990 IF XEN<7 THEN XEN=7 ELSE IF YEN>=BDS THEN YEN=BDS-1
7000 RETURN
7010 LOCATE 0,23:PRINT USING " スキップ長  主:#### 副:####    読み取り長  主:#### 副:####";XST;YST;XEN+1;YEN+1;:RETURN
7020 IF CMD MOD 3=0 THEN RETURN ELSE MOUSE 4,0,0,639,479:GOSUB 6960:CPX=MOUSE(9):CPY=MOUSE(10):WHILE MOUSE(6,1)=0 AND MOUSE(6,0)=0:IF CMD=2 OR CMD=8 THEN 7080
7030 CPY=MOUSE(9):IF CPY=0 THEN 7130 ELSE IF CMD=4 THEN YEN=YEN-CPY ELSE YST=YST-CPY:YEN=YEN+CPY
7040 IF YST<0 THEN YST=0
7050 IF YEN>=BDS THEN YEN=BDS-1
7060 IF YST+YEN>MAY THEN IF YST>0 THEN YST=YST-1:GOTO 7060 ELSE YEN=YEN-1:GOTO 7060
7070 ASS=YST*RSS!:ARS=639-((YEN+1)*RSS!+ASS-1):ASS=639-ASS:GOTO 7130
7080 CPX=MOUSE(10):IF CPX=0 THEN 7130 ELSE IF CMD=2 THEN XEN=XEN+CPX ELSE XST=XST+CPX:XEN=XEN-CPX
7090 IF XST<0 THEN XST=0
7100 IF XEN>=BDM THEN XEN=BDM-1
7110 IF XST+XEN>MAX THEN IF XST>0 THEN XST=XST-1:GOTO 7110 ELSE XEN=(((XEN+1)-8)\8)*8-1:GOTO 7110
7120 ASM=XST*RSM!:ARM=(XEN+1)*RSM!+ASM-1
7130 GOSUB 7010:LINE (ASS,ASM)-(ARS,ARM),XOR,7,B:LINE (ASS,ASM)-(ARS,ARM),XOR,7,B:WEND
7140 IF CMD=1 THEN MMX=ASS ELSE IF CMD=2 THEN MMY=ARM ELSE IF CMD=4 THEN MMX=ARS ELSE MMY=ASM
7150 GOTO 6800
7160 LNX=ASS-ARS:LNY=ARM-ASM:MOUSE 1,ARS,ASM,0:MOUSE 4,60,0,639-LNX,423-LNY
7170 MMX=MOUSE(0):MMY=MOUSE(1):LINE (MMX,MMY)-(MMX+LNX,MMY+LNY),XOR,7,B:LINE (MMX,MMY)-(MMX+LNX,MMY+LNY),XOR,7,B:GOSUB 7210:GOSUB 7010
7180 IF MOUSE(6,0)<>0 THEN 7190 ELSE IF MOUSE(2,1) THEN A=MOUSE(6,1):GOTO 7200 ELSE 7170
7190 GOSUB 7210:GOTO 6650
7200 GOTO 7170
7210 ARS=MMX:ASM=MMY:ASS=ARS+LNX:ARM=ASM+LNY:PCX=639-ASS:PCY=ASM:XST=PCY/RSM!:YST=PCX/RSS!:RETURN
7220 IF MMX<551 THEN XST=OXST:YST=OYST:XEN=OXEN:YEN=OYEN
7230 CLS 4:LINE (0,0)-(58,423),PSET,0,BF:LINE (0,424)-(639,479),PSET,0,BF:GOTO *MENU
7240 LINE (ASS,ASM)-(ARS,ARM),PSET,0,B:PUT@ (ASS,ASM)-(ARS,ASM),G%,PSET,4:PUT@ (ASS,ARM)-(ARS,ARM),CH%,PSET,4:PUT@ (ASS,ASM)-(ASS,ARM),G2%,PSET,4:PUT@ (ARS,ASM)-(ARS,ARM),G3%,PSET,4:LINE (60,0)-(639,423),PSET,7,B:RETURN
7250 GET@ (ASS,ASM)-(ARS,ASM),G%,4,5,6,7:GET@ (ASS,ARM)-(ARS,ARM),CH%,4,5,6,7:GET@ (ASS,ASM)-(ASS,ARM),G2%,4,5,6,7:GET@ (ARS,ASM)-(ARS,ARM),G3%,4,5,6,7:RETURN
7251 *SCROLL_CHECK_FC:SWAP FCX,MMX:SWAP FCY,MMY:GOSUB *SCROLL_CHECK:SWAP FCX,MMX:SWAP FCY,MMY:RETURN
7253 *SCROLL_CHECK:IF SCRLM=0 THEN RETURN
7254  IF MMX<=BSX THEN X=0 ELSE X=MMX-BSX
7255  IF MMY<=BSY THEN Y=0 ELSE Y=MMY-BSY
7256  *SCROLL_CHECK_IN:ON SCM+1 GOSUB *SS0,*SS1,*SS2:RETURN
7257  *SS0:FA=(X \ 8)+Y*128:HAJ=138-(X MOD 8):GOSUB *OUT0:RETURN
7258  *SS1:FA=(X \ 2)+Y*256:HAJ=138-(X MOD 2)*2:GOSUB *OUT0:RETURN
7259  *SS2:FA=(X \ 8)+Y*128:HAJ=138-(X MOD 8):GOSUB *OUT0:GOSUB *OUT1:RETURN
7260  *OUT0:OUT &H440,17:OUT &H442,FA,2:OUT &H440,18:OUT &H442,HAJ,2:RETURN
7261  *OUT1:OUT &H440,21:OUT &H442,FA,2:OUT &H440,22:OUT &H442,HAJ,2:RETURN
7265 *SCRL_INI:IF SCRLM=0 THEN RETURN ELSE X=0:Y=0:GOTO *SCROLL_CHECK_IN
7270 *MOUSE_SCRL_GET:MOUSE 4,0,0,MVX,MVY:WHILE MOUSE(2,0)=0:MMX=MOUSE(0):MMY=MOUSE(1):GOSUB *SCROLL_CHECK:WEND:WHILE MOUSE(6,0)=0:WEND:GOSUB *SCRL_INI:RETURN
7280 *FILE:GOSUB *SCAN_PUT:GOSUB *FBOX_CHK:GOSUB 7660:OSCM=SCM:GOSUB 7720:MOUSE 4,0,0,MVX,MVY:IF SAF=1 THEN GOSUB 7510
7290 IF MOUSE(2,1) THEN WHILE MOUSE(6,1)=0:WEND:GOTO 7440
7300 IF MOUSE(2,0) THEN A=MOUSE(6,0) ELSE MMX=MOUSE(0):MMY=MOUSE(1):GOSUB *SCROLL_CHECK:GOTO 7290
7310 IF MMX>9 AND MMX<311 AND MMY>=MCY AND MMY<=MCY+36 THEN 7520
7320 IF SAF=0 THEN 7460 ELSE GOSUB 7510:CMD=0:IF NOT(MMX>FCX-DI AND MMX<FCX+XLEN+DI AND MMY<FCY+YLEN+DI AND MMY>FCY-DI) THEN 7460
7330 IF ABS(MMX-FCX)<DI THEN CMD=1 ELSE IF ABS(MMX-(FCX+XLEN-1))<DI THEN CMD=2
7340 IF ABS(MMY-FCY)<DI THEN CMD=CMD+4 ELSE IF ABS(MMY-(FCY+YLEN-1))<DI THEN CMD=CMD+8
7350 IF CMD=0 THEN GOSUB 7630:WHILE MOUSE(6,0)=0:FCX=MOUSE(0):FCY=MOUSE(1):GOSUB *SCROLL_CHECK_FC:FCX=FCX-LNX:FCY=FCY-LNY:GOSUB 7510:GOSUB 7710:GOSUB 7510:WEND:GOSUB 7510:SAF=1:MOUSE 4,0,0,MVX,MVY:GOTO 7290
7360 LNX=MMX:LNY=MMY:CPX=MMX:CPY=MMY:MMX=FCX+XLEN-1:MMY=FCY+YLEN-1:IF CMD AND 1 THEN LNX=0:CPX=MMX:MMX=FCX:FCX=CPX ELSE IF CMD AND 2 THEN LNX=FCX:CPX=MVX
7370 IF CMD AND 4 THEN LNY=0:CPY=MMY:MMY=FCY:FCY=CPY ELSE IF CMD AND 8 THEN LNY=FCY:CPY=MVY
7380 IF CPX>MVX THEN CPX=MVX
7390 IF CPY>MVY THEN CPY=MVY
7400 MOUSE 4,LNX,LNY,CPX,CPY:MOUSE 1,MMX,MMY,1:WHILE MOUSE(6,0)=0:ON CMD GOSUB 7410,7410,20,7430,7420,7420,20,7430,7420,7420:GOSUB *SCROLL_CHECK:GOSUB 7500:GOSUB 7700:GOSUB 7500:WEND:GOSUB 7500:MOUSE 4,0,0,MVX,MVY:GOTO 7470
7410 MMX=MOUSE(0):XLEN=ABS(MMX-FCX)+1:RETURN
7420 GOSUB 7410
7430 MMY=MOUSE(1):YLEN=ABS(MMY-FCY)+1:RETURN
7440 IF SAF=1 THEN GOSUB 7510
7450 A=MOUSE(6,0):A&=CALLM(OFFSET&,8):GOSUB 7690:IF MOUSE(2,0)=0 AND (A& AND 16)<>16 THEN MMM=1-(MMM AND 1) ELSE MMM=MMM+2:IF MOUSE(2,0)<>0 THEN WHILE MOUSE(6,0)=0:WEND
7455 GOSUB 7660:GOSUB 7720:IF SAF=1 THEN GOSUB 7510:GOTO 7290 ELSE 7290
7460 FCX=MMX:FCY=MMY:GOSUB 7620:GOSUB 7500
7470 SAF=1:IF MMX<FCX THEN SWAP MMX,FCX
7480 IF MMY<FCY THEN SWAP MMY,FCY
7490 GOSUB 7710:GOTO 7290
7500 LINE (FCX,FCY)-(MMX,MMY),XOR,7,B:RETURN
7510 LINE (FCX,FCY)-(FCX+XLEN-1,FCY+YLEN-1),XOR,7,B:RETURN
7520 MMY=MMY-MCY:IF MMY>18 THEN 7580 ELSE GOSUB 7730:IF SAF=1 THEN GOSUB 7510
7530 IF MMX>226 THEN SCM=OSCM:GOSUB 7690:GOTO *MENU
7540 IF MMX>122 THEN TM$="全領域セーブ":RWFLG=1:GOSUB 7740:GOSUB 7690:IF YN=0 THEN 7570 ELSE GOSUB *GSAVE_SUB1:GOTO 7570
7550 IF MMX>68 THEN TM$="セーブ":RWFLG=1:GOSUB 7740:GOSUB 7690:IF YN=0 THEN 7570 ELSE GOSUB *GSAVE_SUB2:GOTO 7570
7560 TM$="ロード":RWFLG=0:GOSUB 7740:GOSUB 7690:IF YN=0 THEN 7570 ELSE GOSUB *CHECK_COMP:IF YN=0 THEN 7570 ELSE LOAD@ DFD$+DFF$:GOSUB *PALETTE_LOAD:GOSUB *PALETTE_CHANGE:GOSUB *PALETTE_INI
7570 GOSUB 7660:GOSUB 7720:ON ERROR GOTO 0:MOUSE 4,0,0,MVX,MVY:IF SAF=1 THEN GOSUB 7510:GOTO 7290 ELSE 7290
7580 IF MMX>288 THEN GOSUB 7730:GOTO 7440
7590 IF MMX>114 THEN GOSUB 7700:GOSUB 7730:GOSUB 7710:GOTO 7290
7600 GOSUB 7730:SCM=SCM+1:IF SCM>2 THEN SCM=0
7610 CLS:GOSUB *SCREEN_MODE:GOSUB 7660:GOSUB 7720:MOUSE 4,0,0,MVX,MVY:MOUSE 1,MMX,MMY+MCY,1:SAF=0:GOTO 7290
7620 WHILE MOUSE(6,0)=0:MMX=MOUSE(0):MMY=MOUSE(1):GOSUB *SCROLL_CHECK:XLEN=ABS(MMX-FCX)+1:YLEN=ABS(MMY-FCY)+1:GOSUB 7500:GOSUB 7700:GOSUB 7500:WEND:RETURN
7630 LNX=MVX-(FCX+XLEN-1)+MMX:IF LNX>MVX THEN LNX=MVX
7640 LNY=MVY-(FCY+YLEN-1)+MMY:IF LNY>MVY THEN LNY=MVY
7650 MOUSE 4,MMX-FCX,MMY-FCY,LNX,LNY:LNX=MMX-FCX:LNY=MMY-FCY:RETURN
7660 IF MMM=0 THEN MCY=10 ELSE IF MMM=1 THEN MCY=160 ELSE MCY=512
7670 GET@A (10,MCY)-(310,MCY+36),G%:LINE (10,MCY)-(310,MCY+36),PSET,4,BF,1:SYMBOL (16,MCY+2),"ロード セーブ 全領域セーブ メニュー",1,1,4:SYMBOL (12,MCY+20),"ScreenMode"+STR$(SCM)+" (    ,   )-(    ,   ) ◆",1,1,4:LINE (10,MCY+18)-(310,MCY+18),PSET,4
7680 LINE (68,MCY)-(122,MCY+18),PSET,4,B:LINE (226,MCY)-(226,MCY+18),PSET,4:LINE (114,MCY+18)-(288,MCY+36),PSET,4,B:RETURN
7690 PUT@A (10,MCY)-(310,MCY+36),G%,PSET:RETURN
7700 LINE (116,MCY+20)-(283,MCY+35),PSET,1,BF:SYMBOL (116,MCY+20),"セーブ領域 ("+FNG$(XLEN)+","+FNF$(YLEN)+")",1,1,4:RETURN
7710 LINE (116,MCY+20)-(283,MCY+35),PSET,1,BF
7720 SYMBOL (116,MCY+20),"("+FNG$(FCX)+","+FNF$(FCY)+")-("+FNG$(FCX+XLEN-1)+","+FNF$(FCY+YLEN-1)+")",1,1,4:RETURN
7730 WHILE MOUSE(6,0)=0:WEND:RETURN
7740 ON ERROR GOTO 7990:GOSUB 7690
7750 GOSUB *INPUT:YN=FDFLG:IF YN=0 THEN RETURN
7760 ON ERROR GOTO 7990:IF INSTR(DFF$,".")=0 THEN DFF$=LEFT$(DFF$,8)+".TIF":GOTO 7790
7770 A=INSTR(DFF$,"."):IF LEN(DFF$)-A>3 OR A<2 THEN BEEP:YN=0:RETURN
7780 IF MID$(DFF$,A,4)<>".TIF" THEN DFF$=LEFT$(DFF$,A-1)+".TIF"
7790 DFF$=PATH$+DFF$:RETURN
7840 *INPUT
7850 RADBUT=0:RCMD=1:WC$="*.TIF":FDM$="目的の.TIFファイルを設定して下さい｡"
7860 GOSUB *FILE_DIALOG:IF FDFLG=0 THEN RETURN 7570 ELSE IF RIGHT$(PATH$,1)<>"\" THEN PATH$=PATH$+"\"
7870 DFD$=DRIVE$:DFF$=F_NAME$:IF SCSI<>1 THEN CALLM RINIT&:CALLM RCLOSE&:RETURN ELSE RETURN
7880 *ERR_GET_PIC:GET@A (10,MCY)-(310,MCY+36),G%:LINE (10,MCY)-(310,MCY+36),PSET,2,BF,1:RETURN
7885 *ERR_COMP:M$="現バージョンでは圧縮TIFFは未サポートです":GOSUB 8170:RETURN
7990 GOSUB *ERR_GET_PIC:ERRV=ERR:IF ERR=112 THEN M$="画面モードを正しく合わせてください":GOSUB 8170:RESUME NEXT
7995 IF ERR=28 AND ERL=7560 THEN GOSUB *ERR_COMP:RESUME 7570
8000 IF ERR=64 THEN M$="指定のファイルは既に存在しています":GOSUB 8120:IF YN=0 THEN RESUME NEXT ELSE KILL DFD$+DFF$:RESUME
8010 IF ERR=53 THEN M$="入出力装置に異常が発生しました":GOSUB 8170:RESUME NEXT
8020 IF ERR=55 THEN M$="ファイルの記述に誤りがあります":GOSUB 8170:RESUME NEXT
8030 IF ERR=60 THEN M$="指定の入出力装置は使用できません":GOSUB 8170:RESUME NEXT
8040 IF ERR=63 THEN M$="指定のファイルが見つかりません":GOSUB 8170:RESUME NEXT
8050 IF ERR=65 THEN M$="ディスクのディレクトリ領域がいっぱいです":GOSUB 8170:RESUME NEXT
8060 IF ERR=67 THEN M$="ディスクに空き領域がありません":GOSUB 8170:RESUME NEXT
8070 IF ERR=71 THEN M$="ディスクのファイルの構成が正しくありません":GOSUB 8170:RESUME NEXT
8080 IF ERR=72 THEN M$="ディスク装置が使用可能な状態になっていません":GOSUB 8170:RESUME NEXT
8090 IF ERR=73 THEN M$="指定されたディスクは書込が禁止されています":GOSUB 8120:IF YN=0 THEN RESUME NEXT ELSE RESUME
8100 IF ERR=75 THEN M$="アクセスが拒否されました":GOSUB 8170:RESUME NEXT
8110 PRINT "エラーが発生しました。 ID =";ERR;" Line =";ERL:CALLM RCLOSE&,PIT&:END
8120 GOSUB 8150:SYMBOL (180,MCY+20),"中断   続行",1,1,4:SYMBOL (212,MCY+28),"[取消]        [実行]",.5!,.5!,5:LINE (180,MCY+18)-(235,MCY+36),PSET,2,B:LINE (291,MCY+18)-(291,MCY+36),PSET,2:MOUSE 1,212,MCY+24,1:MOUSE 4,180,MCY+18,291,MCY+36
8130 A$="":WHILE MOUSE(2,0)=0 AND A$<>CHR$(13) AND A$<>CHR$(24):A$=INKEY$:WEND:IF A$="" THEN WHILE MOUSE(6,0)=0:WEND:YN=MOUSE(0)\231:GOSUB 7690:RETURN
8140 YN=SGN(24-ASC(A$)):GOSUB 7690:RETURN
8150 ML=KLEN(M$):IF ML<19 THEN SYMBOL (16,MCY+2),M$,1,1,4 ELSE IF ML<25 THEN SYMBOL (16,MCY+2),M$,.75!,1,4 ELSE SYMBOL (16,MCY+2),M$,.5!,1,4
8160 SYMBOL (12,MCY+20),"Error ID ="+FNF$(ERRV),1,1,4:LINE (10,MCY+18)-(310,MCY+18),PSET,2:RETURN
8170 GOSUB 8150:SYMBOL (240,MCY+20),"確認",1,1,4:LINE (238,MCY+18)-(273,MCY+36),PSET,2,B:MOUSE 1,256,MCY+24,1:MOUSE 4,238,MCY+18,273,MCY+36:WHILE MOUSE(2,0)=0:WEND:WHILE MOUSE(6,0)=0:WEND:GOSUB 7690:RETURN
8180 LINE (124,MCY+1)-(307,MCY+17),PSET,0,BF:RETURN
8190 *FBOX_CHK:IF FCX+XLEN-1>MVX THEN FCX=0:XLEN=8
8200 IF FCY+YLEN-1>MVY THEN FCY=0:YLEN=8
8210 RETURN
8220 *END:LINE (MCX,MCY)-(MCX+199,MCY+119),PSET,0,BF,7:SYMBOL (MCX+4,MCY+22),"プログラムを終了します",1,1,0:SYMBOL (MCX+3,MCY+101),"  取消            実行",1,1,0:LINE (MCX+1,MCY+99)-(MCX+198,MCY+99),PSET,0:LINE (MCX+66,MCY+99)-(MCX+132,MCY+119),PSET,0,B
8230 GOSUB *MOUSE_GET:IF A=0 AND MMY<100 THEN 8230 ELSE IF A<>0 THEN IF A=24 THEN *MENU_IN ELSE 8260
8240 CMD=MMX \ 66:ON CMD+1 GOTO *MENU_IN,8250,8260
8250 GOSUB *PALETTE_CHANGE:MOUSE 1,,,0:PUT@A (MCX,MCY)-(MCX+199,MCY+119),G%,PSET:GOSUB *MOUSE_SCRL_GET:GOTO *MENU
8260 PUT@A (MCX,MCY)-(MCX+199,MCY+119),G%,PSET:END
8270 *SCREEN_MODE:A&=CALLM(OFFSET&,8):IF NOT((A& AND 20)<>0 AND SCM=1) AND PSCM=SCM THEN RETURN ELSE IF NOT(SCM=1) AND SCRLM=0 THEN 8307 ELSE IF (A& AND 20)=16 AND SCM=1 THEN SCRLM=1:GOTO 8277
8275 *SCREEN_MODE_IN:IF ZMFV<>0 THEN ON SCM+1 GOTO 8280,8295,8300
8277 ON SCM+1 GOTO 8280,8290,8300
8280 SCREEN@ 0:WINDOW (0,0)-(1023,511):VIEW (0,0)-(1023,511):PSCM=0:ZMFV=0:IF SCRLM=2 THEN GOSUB *SM3:RETURN ELSE GOSUB *SM0:RETURN
8290 IF NOT((A& AND 20)=4) THEN SCREEN@ 1:WINDOW (0,0)-(511,255):VIEW (0,0)-(511,255):PSCM=1:ZMFV=0:IF SCRLM=1 THEN IF MSF=0 THEN GOSUB *SM1:RETURN ELSE GOSUB *SM04:RETURN
8295 SCREEN@ 1,1,(64,112):WINDOW (0,0)-(511,255):VIEW (0,0)-(511,255):GOSUB *SM4:PSCM=1:ZMFV=1:RETURN
8300 SCREEN@ 2:WINDOW (0,0)-(1023,511):VIEW (0,0)-(1023,511):PSCM=2:ZMFV=0:IF SCRLM=2 THEN GOSUB *SM5:RETURN ELSE GOSUB *SM2:RETURN
8307 IF (A& AND 20)=4 THEN SCRLM=2
8308 GOTO 8277
8310 *SCREEN_CALC2:IF SCRLM<>1 THEN SCM=SCM+3
8311 GOTO *SCREEN_CALC_IN
8312 *SCREEN_CALC:A&=CALLM(OFFSET&,8):IF (A& AND 20)=4 THEN SCM=SCM+3
8315 *SCREEN_CALC_IN:ON SCM+1 GOTO *SM0,*SM1,*SM2,*SM3,*SM04,*SM5
8320 *SM0:BDX=639:BDY=479:GOSUB *MVSET02:BSX=639:BSY=479:SCRLM=1:RETURN
8325 *SM3:BDX=1023:BDY=511:MVX=1023:MVY=511:BSX=639:BSY=479:SCRLM=2:SCM=0:RETURN
8330 *SM1:BDX=511:BDY=255:GOSUB *MVSET1:BSX=319:BSY=239:SCRLM=1:MSF=0:RETURN
8335 *SM04:IF ZMFV=0 THEN GOSUB *SM4:BSX=319:BSY=239:SCRLM=1:MSF=1:RETURN
8337 *SM4:BDX=511:BDY=255:MVX=511:MVY=255:BSX=511:BSY=255:SCRLM=0:SCM=1:MSF=1:RETURN
8340 *SM2:BDX=639:BDY=479:GOSUB *MVSET02:BSX=639:BSY=479:SCRLM=1:RETURN
8341 *SM5:BDX=1023:BDY=511:MVX=1023:MVY=511:BSX=639:BSY=479:SCRLM=2:SCM=2:RETURN
8342 *MVSET02:A&=CALLM(OFFSET&,8):IF (A& AND 16)=16 THEN MVX=1023:MVY=511:RETURN ELSE MVX=639:MVY=511:RETURN
8345 *MVSET1:A&=CALLM(OFFSET&,8):IF (A& AND 16)=16 THEN MVX=511:MVY=255:RETURN ELSE MVX=319:MVY=255:RETURN
8350 *PALETTE_SET:IF PSCM=1 THEN RETURN ELSE PALETTE
8360 IF SCM=2 THEN 8370 ELSE *PALETTE_CHANGE
8370 ON PALM GOTO 8380,*PALETTE_CHANGE,*PALETTE_CHANGE:RETURN
8380 ON (CCOL\16)+1 GOSUB 8400,8410,8420,8430:GOSUB 8440:GOSUB *PALETTE_CHANGE:RETURN
8390 *PAL_PAL:OFPAL=FPAL:FPAL=PAL2 MOD 3:ON (CCOL\16)+1 GOSUB 8400,8410,8420,8430:GOSUB 8440:FPAL=OFPAL:RETURN
8400 FOR A=0 TO 255:PAL&(A)=A*65536+A*256+A:NEXT:RETURN
8410 FOR A=0 TO 255:PAL&(A)=A*256:NEXT:RETURN
8420 FOR A=0 TO 255:PAL&(A)=A*65536:NEXT:RETURN
8430 FOR A=0 TO 255:PAL&(A)=A:NEXT:RETURN
8440 ON FPAL GOTO 8450,8460:RETURN
8450 FOR A=0 TO 7:PAL&(A)=IP%(A,1)*65536+IP%(A,2)*256+IP%(A,3):NEXT:PAL&(8)=0:RETURN
8460 PAL&(0)=0:PAL&(8)=4210752:FOR A=1 TO 7:PAL&(A)=((IP%(A,1)+1)\2)*65536+((IP%(A,2)+1)\2)*256+((IP%(A,3)+1)\2):PAL&(A+8)=IP%(A,1)*65536+IP%(A,2)*256+IP%(A,3):NEXT:PAL&(16)=0:RETURN
8470 *PALETTE_CHANGE:IF SCM<>PSCM THEN RETURN
8480 ON SCM+1 GOTO 8500,8490,8510
8490 RETURN
8500 FOR A=0 TO 15:PALETTE A,[(PAL&(A) AND 16711680)\65536,(PAL&(A) AND 65280)\256,PAL&(A) AND 255]:NEXT:RETURN
8510 FOR A=0 TO 255:PALETTE A,[(PAL&(A) AND 16711680)\65536,(PAL&(A) AND 65280)\256,PAL&(A) AND 255]:NEXT:RETURN
8520 *PALETTE_INI:IF SCM<>PSCM THEN RETURN
8530 ON PSCM+1 GOTO 8550,8540,8560
8540 RETURN
8550 FOR A=0 TO 7:PALETTE A+SGN(A)*8,[IP%(A,1),IP%(A,2),IP%(A,3)]:NEXT:RETURN
8560 FOR A=0 TO 7:PALETTE IP%(A,0),[IP%(A,1),IP%(A,2),IP%(A,3)]:NEXT:RETURN
8570 *PALETTE_UNDO:IF SCM<>PSCM THEN RETURN
8580 ON PSCM+1 GOTO 8600,8590,8610
8590 RETURN
8600 FOR A=0 TO 7:B=A+SGN(A)*8:PALETTE B,[(PAL&(B) AND 16711680)\65536,(PAL&(B) AND 65280)\256,PAL&(B) AND 255]:NEXT:RETURN
8610 FOR A=0 TO 7:K=IP%(A,0):PALETTE K,[(PAL&(K) AND 16711680)\65536,(PAL&(K) AND 65280)\256,PAL&(K) AND 255]:NEXT:RETURN
8620 *PALETTE_SAVE:RETURN
8630 *PALETTE_LOAD:PS$=DFD$+DFF$
8640 *PALETTE_LOAD_IN:GOSUB *CHECK_TAG6:CLOSE:IF YN=0 THEN PS$=LEFT$(PS$,LEN(PS$)-4)+".PLT":ON ERROR GOTO 8760:IF SCM<>1 THEN 8730
8720 ON ERROR GOTO 0:RETURN
8730 OPEN "I",#1,PS$:A!=CVL(INPUT$(4,1)):CLOSE:IF HEX$(A!)="F0000000" THEN *PALETTE_PALETTE ELSE ON SCM+1 GOTO 8740,8720,8750
8740 OPEN "I",#1,PS$:FOR A=0 TO 15:PAL&(A)=CVL(INPUT$(4,1)):NEXT:CLOSE:IF PALM=0 THEN PALM=1:RETURN ELSE RETURN
8750 LOAD@ PS$,PAL&:IF PALM=0 THEN PALM=1:RETURN ELSE RETURN
8760 IF ERR=63 THEN GOSUB *PALETTE_PALETTE:RESUME 8720
8770 PRINT "Error ";ERR;" in ";ERL:CALLM RCLOSE&,PIT&:END
8780 *PALETTE_FIX:ON CMD+1 GOSUB *PALETTE_PALETTE,8790,8810,8840,8870:GOSUB *PALETTE_CHANGE:RETURN
8790 PAL&(0)=0:IF PSCM=0 THEN PAL&(7)=8421504:PAL&(15)=16777215:RETURN
8800 PAL&(182)=12566463:PAL&(255)=16777215:RETURN
8810 IF PSCM=0 THEN GOSUB *PALETTE_PALETTE:RETURN
8820 RESTORE 9010:FOR A=1 TO 6:READ BY&(A):NEXT:FOR A=0 TO 31:A!=263172*A:GOSUB 8880:PAL&(A)=A!:A!=263172*A:GOSUB 8880:PAL&(255-A)=A!:NEXT:FOR B=1 TO 6:FOR A=0 TO 31:A!=BY&(B)*((31-A)*8+7):GOSUB 8880:PAL&(B*32+A)=A!:NEXT:NEXT
8830 FOR A=0 TO 31:A!=8618883+263172*A:GOSUB 8880:PAL&(224+A)=A!:NEXT:RETURN
8840 IF PSCM=0 THEN GOSUB *PALETTE_PALETTE_IN:FOR A=1 TO 7:SWAP PAL&(A),PAL&(A+8):NEXT:RETURN
8850 RESTORE 9010:FOR A=1 TO 6:READ BY&(A):NEXT:FOR A=0 TO 31 STEP 2:FOR B=1 TO 6:A!=BY&(B)*((31-(A\2))*8+7):GOSUB 8880:PAL&(A*8+B)=A!:A!=BY&(B)*((15-(A\2))*8+7):GOSUB 8880:PAL&((A+1)*8+B)=A!:NEXT:NEXT
8860 FOR A=0 TO 31 STEP 2:A!=263172*(A\2):GOSUB 8880:PAL&(A*8)=A!:A!=263172*(16+(A\2)):GOSUB 8880:PAL&((A+1)*8)=A!:A!=16777215-263172*(A\2):GOSUB 8880:PAL&(A*8+7)=A!:A!=16777215-263172*(16+(A\2)):GOSUB 8880:PAL&((A+1)*8+7)=A!:NEXT:RETURN
8870 GOSUB *PAL_PAL:RETURN
8880 IF A!>=2147483648# THEN A!=A!-4294967296#
8890 RETURN
8900 SCREEN@ 0:CLS:PALETTE:FOR A=0 TO 255:PRINT USING "### : [G : ###  R : ###  B : ### ]";A;(PAL&(A) AND 16711680)\65536;(PAL&(A) AND 65280)\256;PAL&(A) AND 255:A$=INPUT$(1):NEXT:CALLM RCLOSE&,PIT&:END
8910 SCREEN@ 0:CLS:PALETTE:A#=8421504:PRINT USING "[G : ###  R : ###  B : ### ]";(A# AND 16711680)\65536;(A# AND 65280)\256;A# AND 255:A$=INPUT$(1):CALLM RCLOSE&,PIT&:END
8920 *PALETTE_PALETTE:ON ERROR GOTO 0:ON PSCM+1 GOTO 8940,8930,8950
8930 RETURN
8940 GOSUB 8970:PALETTE:RETURN
8950 GOSUB *INI256:PALETTE:RETURN
8960 *PALETTE_PALETTE_IN:ON ERROR GOTO 0:ON SCM+1 GOTO 8970,8930,*INI256
8970 GOSUB *INI256:RESTORE 8990:FOR A=0 TO 15:READ PAL&(A):NEXT:A&=16:RETURN
8980 *INI256:A=0:FOR G=0 TO 7:FOR R=0 TO 7:FOR B=0 TO 3:PAL&(A)=(G*32+31*SGN(G))*65536+(R*32+31*SGN(R))*256+(B*64+63*SGN(B)):A=A+1:NEXT:NEXT:NEXT:A&=256:RETURN
8990 DATA 0,128,32768,32896,8388608,8388736,8421376,8421504,4210752,255,65280,65535,16711680,16711935,16776960,16777215
9000 DATA 8158332,255,65280,65535,16711680,16711935,16776960,16777215,                263172,7,1792,1799,458752,458759,460544,263172
9010 DATA 1,256,257,65536,65537,65792
9100 *CHECK_TAG6
9110 ON ERROR GOTO 8760:OPEN "I",#1,PS$
9130  DUM$=INPUT$(&H36,1):DUM$=INPUT$(2,1):BIT=ASC(LEFT$(DUM$,1))+ASC(RIGHT$(DUM$,1))*256
9140 IF BIT<>4 AND BIT<>8 THEN GOSUB *PALETTE_PALETTE:YN=0:RETURN
9150 DUM$=INPUT$(22,1):DUM$=INPUT$(2,1):PYNF=ASC(LEFT$(DUM$,1))+ASC(RIGHT$(DUM$,1))*256
9160 IF PYNF<>3 THEN GOSUB *PALETTE_PALETTE:YN=0:RETURN
9170 DUM$=INPUT$(118,1):DUM$=INPUT$(2,1):POLN&=ASC(LEFT$(DUM$,1))+ASC(RIGHT$(DUM$,1))*256:DUM$=INPUT$(2,1):POLN&=POLN&+(ASC(LEFT$(DUM$,1))+ASC(RIGHT$(DUM$,1))*256)*65536:POLN&=POLN&-&HCA
9180 WHILE POLN&>255:DUM$=INPUT$(255,1):POLN&=POLN&-255:WEND:IF POLN&<>0 THEN DUM$=INPUT$(POLN&,1)
9190 IF BIT=8 THEN A&=256 ELSE A&=16
9200 *TAG_PAL
9210 FOR A=0 TO A&-1:DUM$=INPUT$(2,1):PAL&(A)=ASC(RIGHT$(DUM$,1))*256:NEXT
9220 FOR A=0 TO A&-1:DUM$=INPUT$(2,1):PAL&(A)=PAL&(A)+ASC(RIGHT$(DUM$,1))*65536:NEXT
9230 FOR A=0 TO A&-1:DUM$=INPUT$(2,1):PAL&(A)=PAL&(A)+ASC(RIGHT$(DUM$,1)):NEXT
9240 YN=1:IF PALM=0 THEN PALM=1:RETURN ELSE RETURN
9500 *GSAVE_SUB1:GOSUB *PALETTE_CHANGE_CHECK:IF SCM<>1 THEN GOSUB *PALETTE_CHANGE:SAVE@ DFD$+DFF$,(0,0)-(MVX,MVY),YN ELSE SAVE@ DFD$+DFF$,(0,0)-(MVX,MVY)
9510 RETURN
9550 *GSAVE_SUB2:GOSUB *PALETTE_CHANGE_CHECK:IF SCM<>1 THEN GOSUB *PALETTE_CHANGE:SAVE@ DFD$+DFF$,(FCX,FCY)-(FCX+XLEN-1,FCY+YLEN-1),YN ELSE SAVE@ DFD$+DFF$,(FCX,FCY)-(FCX+XLEN-1,FCY+YLEN-1)
9560 RETURN
9600 *CHECK_COMP
9610  ON ERROR GOTO *CHECK_ERR
9630  OPEN "I",#1,DFD$+DFF$
9640  DUM$=INPUT$(&H42,1):DUM$=INPUT$(2,1):CMPFLG%=ASC(LEFT$(DUM$,1))+ASC(RIGHT$(DUM$,1))*256:CLOSE #1
9650  IF CMPFLG%<>1 THEN GOSUB *ERR_GET_PIC:ERRV=28:GOSUB *ERR_COMP:YN=0:RETURN
9660  *CHECK_RET
9670  ON ERROR GOTO 7990:YN=1:RETURN
9680 *CHECK_ERR
9690  RESUME *CHECK_RET
9800 *PALETTE_CHANGE_CHECK:YN=0:ON SCM+1 GOTO 9810,9850,9830
9810 RESTORE 8990:FOR A=0 TO 15:READ PV&:IF PAL&(A)<>PV& THEN YN=1
9820 NEXT:RETURN
9830 A=0:FOR G=0 TO 7:FOR R=0 TO 7:FOR B=0 TO 3:IF PAL&(A)<>(G*32+31*SGN(G))*65536+(R*32+31*SGN(R))*256+(B*64+63*SGN(B)) THEN YN=1
9840 A=A+1:NEXT:NEXT:NEXT:RETURN
9850 RETURN
10000 *PF_PALETTE
10010 PALETTE:RETURN
15000 *DEPTH_SET:DFB=DFO:A&=CALLM(OFFSET&,8):IF (A& AND 20)=0 THEN PAR$=CHR$(DFO):RETURN
15010 IF (A& AND 20)=20 THEN DFB=DFB-3:GOTO *DEPTHRET
15020 IF (A& AND 4)=4 THEN DFB=DFB-1:GOTO *DEPTHRET
15030 DFB=DFB-2
15040 *DEPTHRET:IF DFB<3 THEN DFB=3
15050 PAR$=CHR$(DFB):RETURN
49999 '*SKB_TEST:MOUSE 0:MOUSE 1,,,1:DIM SKB%(2687):CLS:SKBX=40:SKBY=200:GOSUB *SKB_WRT:WHILE K$<>CHR$(13):GOSUB *SKB_GET:PRINT K$;:WEND:GOSUB *SKB_DEL:END
50000 *SKB_WRT
50010 GET@A (SKBX,SKBY)-(SKBX+127,SKBY+41),SKB%
50020 MOUSE 1,SKBX,SKBY,1:MOUSE 4,SKBX,SKBY,SKBX+127,SKBY+41
50030 LINE (SKBX,SKBY)-(SKBX+127,SKBY+41),PSET,0,BF,7
50040 SYMBOL (SKBX,SKBY+1),"ABCDEFGHIJKLMNOP",1,.75!,0
50050 SYMBOL (SKBX,SKBY+15),"QRSTUVWXYZ._-@$'",1,.75!,0
50060 SYMBOL (SKBX,SKBY+29),"0123456789&#%!<",1,.75!,0:SYMBOL (SKBX+114,SKBY+29),"＝』",.5!,.75!,0:RETURN
50500 *SKB_DEL
50510 MOUSE 1,FDXM+200,FDYM+320,1:MOUSE 4,FDXM+25,FDYM-4,FDXM+320,FDYM+349
50520 PUT@A (SKBX,SKBY)-(SKBX+127,SKBY+41),SKB%:RETURN
51000 *SKB_GET
51010 K$=""
51020 WHILE K$=""
51030   K$=INKEY$:IF K$<>"" THEN *SKB_LOP_OUT
51040   IF MOUSE(2,0)=0 THEN *SKB_LOP_OUT
51050     WHILE MOUSE(6,0)=0:WEND
51060     MMX=MOUSE(0)-SKBX:MMY=MOUSE(1)-SKBY
51070     IF 0>MMX OR 0>MMY OR MMX>127 OR MMY>41 THEN *SKB_NEXT_LOP ELSE MMX=(MMX \ 8)+1
51080        IF MMY<14 THEN K$=MID$("ABCDEFGHIJKLMNOP",MMX,1):GOTO *SKB_LOP_OUT
51090        IF MMY<28 THEN K$=MID$("QRSTUVWXYZ._-@$'",MMX,1):GOTO *SKB_LOP_OUT
51100        IF MMY<42 THEN K$=MID$("0123456789&#%!"+CHR$(8)+CHR$(13),MMX,1):GOTO *SKB_LOP_OUT
51110 *SKB_NEXT_LOP:BEEP
51120 *SKB_LOP_OUT:WEND:RETURN
60000 *FILE_DIALOG:ON ERROR GOTO *エラー処理
60010 ON RIFLG+1 GOTO *RADBUT_IN0,*RADBUT_IN1,*RADBUT_IN2
60020 *RADBUT_IN0
60030 FSCM=PSCM:GET@A (0,0)-(511+512*ABS(SGN(PSCM-1)),255+256*ABS(SGN(PSCM-1))),GBAK%:SCREEN@ 0:CONSOLE 0,25:COLOR 7,,,0:CLS:PALETTE
60040 MOUSE 0:MOUSE 1,FDXM+200,FDYM+320,1:MOUSE 4,FDXM+25,FDYM-4,FDXM+320,FDYM+349
60050 LOCATE FDX+21-(LEN(TM$)\2),FDY:PRINT TM$:LOCATE FDX+22,FDY+15:PRINT "実行  取消":LOCATE FDX+30,FDY+1:PRINT "    0KB":LOCATE FDX+22,FDY+4:PRINT "親"
60060 LOCATE FDX+22,FDY+5:PRINT "↑":LOCATE FDX+22,FDY+13:PRINT "↓":LOCATE FDX+6,FDY+2:PRINT "《　 Ｑ　 》"
60070 LINE(FDXM+25,FDYM-4)-(FDXM+320,FDYM+349),PSET,0,BF,%8:LINE(FDXM+25,FDYM-4)-(FDXM+320,FDYM+349),PSET,0,BF,%8:LINE(FDXM+38,FDYM+94)-(FDXM+153,FDYM+265),PSET,7,B
60080 LINE(FDXM+38,FDYM+283)-(FDXM+153,FDYM+302),PSET,7,B:LINE(FDXM+38,FDYM+74)-(FDXM+153,FDYM+92),PSET,7,B:LINE(FDXM+39,FDYM+26)-(FDXM+153,FDYM+64),PSET,7,B
60090 LINE(FDXM+172,FDYM+282)-(FDXM+209,FDYM+302),PSET,7,B:LINE(FDXM+220,FDYM+282)-(FDXM+257,FDYM+302),PSET,7,B:LINE(FDXM+236,FDYM+16)-(FDXM+297,FDYM+36),PSET,7,B
60100 LINE(FDXM+172,FDYM+74)-(FDXM+194,FDYM+92),PSET,7,B:LINE(FDXM+172,FDYM+94)-(FDXM+194,FDYM+112),PSET,7,B:LINE(FDXM+172,FDYM+112)-(FDXM+194,FDYM+245),PSET,7,B
60110 LINE(FDXM+172,FDYM+245)-(FDXM+194,FDYM+264),PSET,7,B:LINE(FDXM+76,FDYM+26)-(FDXM+116,FDYM+64),PSET,7,B
60120 SKBX=FDXM+25:SKBY=FDYM+350:GOSUB *PUT_FDMES
60130 *初期化
60140 MOFF=0
60150 RESTORE *CLICK_AREA
60160 FOR I=1 TO MAXCMD
60170     FOR J=1 TO 4
60180         READ XY(I,J)
60190     NEXT J
60200 NEXT I
60210 *RADBUT_IN1
60220 GOSUB *RADIO_BUTTON
60230 GOSUB *接続ドライブ
60240 GOSUB *GETCD
60250 GOSUB *DRV_HYO
60260 GOSUB *GETDIR
60270 IF RET&=-1 THEN GOSUB *NOT_DRV:GOTO *FD_MAIN_LOOP
60280 GOSUB *SEARCH
60290 GOSUB *DISK_FREE
60300 GOSUB *SORT
60310 F_NUM=1
60320 GOSUB *HYOUJI
60330 *RADBUT_IN2:FDFLG=0
60340 *FD_MAIN_LOOP
60350 MX=MOUSE(0)-FDXM:MY=MOUSE(1)-FDYM
60360 J=0:A$=INKEY$:IF A$=CHR$(13) THEN J=CANCMD-1 ELSE IF A$=CHR$(24) THEN J=CANCMD
60370 FOR I=1 TO MAXCMD
60380     IF MOUSE(2,0) AND MX>XY(I,1) AND MX<XY(I,3) THEN IF MY>XY(I,2) AND MY<XY(I,4) THEN J=I:I=100
60390 NEXT I
60400 IF J THEN *ON_MOUSE
60410 GOTO *FD_MAIN_LOOP
60420 *ON_MOUSE
60430 IF MOFF AND J>3 AND J<>CANCMD AND J<>BUTCMD THEN *FD_MAIN_LOOP
60440 ON J GOSUB *ON_LEFT,*ON_DRV,*ON_RIGHT,*ON_OYA,*ON_LIST,*ON_UP,*ON_DOWN,*ON_RUN,*ON_CANCEL,*ON_INPUT,*ON_SCROLL_BAR,*ON_BUTTON
60450 GOTO *FD_MAIN_LOOP
60460 *ON_LEFT
60470 MOFF=1
60480 GOSUB *LEFT_DRV
60490 GOSUB *DRV_HYO
60500 GOSUB *HYOUJI:WAIT 10
60510 RETURN
60520 *ON_DRV
60530 WHILE MOUSE(2,0)<>0:WEND
60540 MOFF=0
60550 FILENAME$=""
60560 GOSUB *HYOUJI_SPC
60570 GOSUB *DRV_SENTAKU
60580 RETURN
60590 *ON_RIGHT
60600 MOFF=1
60610 GOSUB *RIGHT_DRV
60620 GOSUB *DRV_HYO
60630 GOSUB *HYOUJI:WAIT 10
60640 RETURN
60650 *ON_UP
60660 IF F_NUM>1 THEN F_NUM=F_NUM-1:GOSUB *HYOUJI
60670 RETURN
60680 *ON_DOWN
60690 IF F_NUM<F_S-8 THEN F_NUM=F_NUM+1:GOSUB *HYOUJI
60700 RETURN
60710 *ON_OYA
60720 WHILE MOUSE(2,0)<>0:WEND
60730 DUMMYY$=SPACE$(14):DUMMYP$="."+CHR$(0)
60740 A=CALLM (OFFSET&,0,VARPTR(DUMMYP$),VARPTR(DUMMYY$),&H10,0)
60750 IF A=0 THEN SHELL "CD .."
60760 GOSUB *ON_DRV
60770 RETURN
60780 *ON_LIST
60790 I=0
60800 IF F_S<9 THEN K=F_S ELSE K=9
60810 IF K=0 OR FILE_SU=-1 THEN RETURN
60820 FOR J=1 TO K
60830     IF MY<95+19*J THEN I=J:J=10
60840 NEXT J
60850 IF I THEN GOSUB *SETFILE
60860 RETURN
60870 *SETFILE
60880 FILENAME$=MID$(FILE_NAME$(F_NUM+I-1+ROOT),2,14)
60890 IF ASC(FILENAME$)=60 THEN *SETDIR
60900 GOSUB *HYOUJI
60910 COLOR ,,,5:LOCATE FDX+5,FDY+4+I:PRINT " "+FNFF$(MID$(FILENAME$,2,12))+" ":COLOR 7,,,0
60920 LOCATE FDX+6,FDY+15:PRINT MID$(FILENAME$,2,12)
60930 RETURN
60940 *SETDIR
60950 DIR$=MID$(FILENAME$,2,12)
60960 GOSUB *CDDIRMOVE
60970 GOSUB *ON_DRV
60980 RETURN
60990 *ON_RUN
61000 IF LEFT$(MID$(FILENAME$,2,12)+SPACE$(12),12)=SPACE$(12) THEN RETURN ELSE FDFLG=1
61010 DRIVE$=MID$(DRV_SET$,DRV_NO,1)+":":PATH$=LEFT$(DIR$,INSTR(DIR$+" "," ")-1):F_NAME$=MID$(FILENAME$,2,12):F_NAME$=LEFT$(F_NAME$,INSTR(F_NAME$+" "," ")-1)
61020 RETURN *RET_RET
61030 *ON_CANCEL
61040 FDFLG=0
61050 RETURN *RET_RET
61060 *RET_RET:RIFLG=0:PSCM=10:SWAP FSCM,SCM:A&=0:GOSUB *SCREEN_MODE_IN:SWAP FSCM,SCM
61065 CLS:PUT@A (0,0)-(511+512*ABS(SGN(PSCM-1)),255+256*ABS(SGN(PSCM-1))),GBAK%:ON ERROR GOTO 0:RETURN
61070 *ON_INPUT:WHILE MOUSE(6,0)=0:WEND:IF RWFLG=0 THEN RETURN ELSE GOSUB *SKB_WRT
61080 FT$=MID$(FILENAME$,2,12):WHILE RIGHT$(FT$,1)=" ":FT$=LEFT$(FT$,LEN(FT$)-1):WEND
61090 CP=LEN(FT$)
61100 K$=""
61110 WHILE K$<>CHR$(13)
61120   CP=LEN(FT$):LINE(FDXM+40,FDYM+284)-(FDXM+152,FDYM+301),PSET,1,BF:LINE ((FDX+6+CP)*8+1,FDYM+285)-((FDX+6+CP)*8+1,FDYM+300),PSET,2
61130     GOSUB *SKB_GET:'K$=INPUT$(1)
61140     IF K$=CHR$(8) OR K$=CHR$(29) THEN GOSUB *IN_DEL_LAST_C:GOTO *IN_PUT
61150     IF K$<CHR$(33) THEN *P_SKP ELSE FT$=FT$+K$
61160     CP=LEN(FT$):IF CP>12 THEN BEEP:FT$=LEFT$(FT$,12):CP=12:GOTO *P_SKP
61170     IF INSTR(FT$,".")>9 THEN GOSUB *IN_DEL_LAST:GOTO *P_SKP
61180     IF CP=9 AND INSTR(FT$,".")<2 THEN GOSUB *IN_DEL_LAST:GOTO *P_SKP
61190     IF CP>INSTR(FT$,".")+3 AND INSTR(FT$,".")>1 THEN GOSUB *IN_DEL_LAST:GOTO *P_SKP
61200   *IN_PUT
61210    LOCATE FDX+6,FDY+15:PRINT LEFT$(FT$+"            ",12)+" "
61220   *P_SKP
61230 WEND
61240 LINE(FDXM+40,FDYM+284)-(FDXM+152,FDYM+301),PSET,%8,BF
61250 FILENAME$="F"+LEFT$(FT$+"            ",12)+CHR$(0):GOSUB *SKB_DEL
61260 RETURN
61270 *IN_DEL_LAST
61280 CP=LEN(FT$)-1:BEEP:FT$=LEFT$(FT$,CP):RETURN
61290 *IN_DEL_LAST_C
61300 IF LEN(FT$)=0 THEN BEEP:RETURN ELSE FT$=KLEFT$(FT$,KLEN(FT$)-1):CP=LEN(FT$):RETURN
61310 *ON_BUTTON
61320 OCMD=RCMD:RCMD=((MY-76)\19)+1
61330 IF RCMD>RADBUT THEN RCMD=OCMD:RETURN
61340 GOSUB *DISP_RADIO
61350 IF RETFLG(RCMD-1)=0 THEN RETURN ELSE RETURN *RADBUTRET
61360 *RADBUTRET
61370 FDFLG=2:RETURN
61380 *RADIO_BUTTON:IF RADBUT=0 THEN RETURN
61390 GOSUB *DISP_RADIO
61400 FOR I=0 TO RADBUT-1
61410   LOCATE FDX+27,FDY+4+I:PRINT RADBUT$(I)
61420 NEXT
61430 RETURN
61440 *DISP_RADIO:IF RADBUT=0 THEN RETURN
61450 FOR I=0 TO RADBUT-1
61460   LOCATE FDX+25,FDY+4+I:PRINT "○";
61470 NEXT
61480 IF RCMD<>0 THEN  LOCATE FDX+25,FDY+3+RCMD:PRINT "●";
61490 RETURN
61500 *SCROLL_BAR
61510 LINE(FDXM+172,FDYM+112)-(FDXM+194,FDYM+245),PSET,7,BF,%8
61520 IF MOFF=1 OR F_S<10 THEN IF MOFF=1 THEN RETURN ELSE LINE(FDXM+173,FDYM+113)-(FDXM+193,FDYM+244),PSET,0,BF,%15:RETURN
61530 BOX_Y1=BOX_S!*(F_NUM-1):BOX_Y2=130-(BOX_Y1+BOX_RH)
61540 IF BOX_Y2<0 THEN BOX_Y2=0
61550 IF BOX_Y1>B_MAX THEN BOX_Y1=B_MAX
61560 LINE (FDXM+173,FDYM+113+BOX_Y1)-(FDXM+193,FDYM+244-BOX_Y2),PSET,0,BF,%15
61570 RETURN
61580 *ON_SCROLL_BAR
61590 IF MOFF=1 OR F_S<10 THEN RETURN
61600 IF F_S<9 THEN F_NUM_HYO=FILE_SU ELSE F_NUM_HYO=F_NUM+8+ROOT
61610 IF ( ROOT=2 AND F_NUM_HYO=2 ) OR FILE_SU=0 THEN RETURN
61620 IF MY<BOX_Y1+113 OR MY>244-BOX_Y2 THEN B_Y1=(MY-113-(BOX_RH/2)):GOTO *SCROLL_CLICK ELSE OI=257
61630 WHILE MOUSE(2,0)<>0:MY=MOUSE(1)-FDYM:B_Y1=(MY-113-(BOX_RH/2)):OI=I:I=B_Y1/BOX_S!
61640   IF I<0 THEN I=0
61650   IF I>F_S-9 THEN I=F_S-9
61660   I=I+1:B_Y1=BOX_S!*(I-1):B_Y2=130-(B_Y1+BOX_RH)
61670   IF B_Y2<0 THEN B_Y2=0
61680   IF B_Y1>B_MAX THEN B_Y1=B_MAX
61690   IF OI<>I THEN LINE(FDXM+172,FDYM+112)-(FDXM+194,FDYM+245),PSET,7,BF,%8:LINE (FDXM+173,FDYM+113+B_Y1)-(FDXM+193,FDYM+244-B_Y2),PSET,0,BF,%15
61700 WEND:GOTO *SCROLL_RET
61710 *SCROLL_CLICK:I=B_Y1/BOX_S!
61720 IF I<0 THEN I=0
61730 IF I>F_S-9 THEN I=F_S-9
61740 I=I+1
61750 *SCROLL_RET
61760 F_NUM=I:GOSUB *HYOUJI
61770 RETURN
61780 *LEFT_DRV
61790 DRV_NO=DRV_NO-1
61800 IF DRV_NO=0 THEN DRV_NO=DRV_SU
61810 RETURN
61820 *RIGHT_DRV
61830 DRV_NO=DRV_NO+1
61840 IF DRV_NO>DRV_SU THEN DRV_NO=1
61850 RETURN
61860 *DRV_SENTAKU
61870 F_NUM=1
61880 GOSUB *CDMOVE
61890 GOSUB *GETDIR
61900 IF RET&=-1 THEN GOSUB *NOT_DRV:RETURN
61910 GOSUB *SEARCH
61920 GOSUB *DISK_FREE
61930 GOSUB *SORT
61940 GOSUB *HYOUJI
61950 RETURN
61960 *GETCD
61980 DMMY$=CHR$(CALLM (OFFSET&,1))
61990 DRV_NO=INSTR(1,DRV_SET$,DMMY$)
62000 RETURN
62010 *GETDIR
62020 DMMY$=MID$(DRV_SET$,DRV_NO,1)
62030 DIR$=SPACE$(65)
62040 RET&=CALLM(OFFSET&,2,ASC(DMMY$),VARPTR(DIR$))
62050 I=KINSTR(DIR$,"\")
62060 J=I
62070 WHILE I
62080       J=I
62090       I=KINSTR(J+1,DIR$,"\")
62100 WEND
62110 LOCATE FDX+6,FDY+4:PRINT KMID$(DIR$,J+1,12)
62120 RETURN
62130 *CDMOVE
62140 DMMY$=MID$(DRV_SET$,DRV_NO,1)
62150 SHELL DMMY$+":":'CALLM OFFSET&,3,asc(DMMY$)
62160 RETURN
62170 *CDDIRMOVE
62180 DIR$=DIR$+CHR$(0)
62190 CALLM OFFSET&,4,VARPTR(DIR$):'SHELL "CD "+DIR$
62200 RETURN
62210 *SEARCH:LINE(FDXM+38,FDYM+94)-(FDXM+153,FDYM+265),PSET,7,BF,%1:IF BASCOM=1 THEN *SEARCH_COM
62220 GOSUB *SEARCH_DIR
62230 PATH_ALL$=WC$+CHR$(0)
62240 A=CALLM (OFFSET&,0,VARPTR(PATH_ALL$),VARPTR(FILE_NAME$(FILE_SU+1)),0,0)
62250 IF A<>0 THEN RETURN ELSE FILE_SU=FILE_SU+1
62260 FILE_NAME$(FILE_SU)="2 "+MID$(FILE_NAME$(FILE_SU),2,12)+" "
62270 FOR I=FILE_SU+1 TO 256
62280     A=CALLM (OFFSET&,0,VARPTR(PATH_ALL$),VARPTR(FILE_NAME$(I)),0,1)
62290     IF A<>0 THEN FILE_SU=I-1:I=257:GOTO *LOOPOUT ELSE FILE_SU=I
62300     KAKUNO$=FILE_NAME$(I)
62310     FILE_NAME$(I)="2 "+MID$(KAKUNO$,2,12)+" "
62320 *LOOPOUT
62330 NEXT I
62340 RETURN
62350 *SEARCH_DIR
62360 PATH_ALL$="*.*"+CHR$(0)
62370 A=CALLM (OFFSET&,0,VARPTR(PATH_ALL$),VARPTR(FILE_NAME$(1)),&H10,0)
62380 ROOT=0:FILE_SU=0
62390 IF A<>0 THEN RETURN ELSE FILE_SU=2
62400 IF KMID$(FILE_NAME$(1),2,1)="." THEN ROOT=2
62410 IF ASC(FILE_NAME$(1))=68 THEN FILE_NAME$(1)="1<"+MID$(FILE_NAME$(1),2,12)+">" ELSE FILE_SU=1
62420 FOR I=FILE_SU TO 256
62430     A=CALLM (OFFSET&,0,VARPTR(PATH_ALL$),VARPTR(FILE_NAME$(I)),&H10,1)
62440     IF A<>0 THEN FILE_SU=I-1:I=257:GOTO *LOOPOUTD ELSE FILE_SU=I
62450     KAKUNO$=FILE_NAME$(I)
62460     IF ASC(KAKUNO$)=68 THEN FILE_NAME$(I)="1<"+MID$(KAKUNO$,2,12)+">" ELSE I=I-1
62470 *LOOPOUTD
62480 NEXT I
62490 RETURN
62500 *SEARCH_COM
62510 WCS$=STRING$(12,CHR$(0)):WCT$=FNFF$(WC$):MID$(WCT$,9,1)=" "
62520 FOR A=0 TO 11
62530  A$=MID$(WCT$,A+1,1)
62540  IF A<8 AND A$="*" THEN FOR B=A TO 7:WC(B)=0:NEXT:A=8:GOTO *WCGEN_NEXT
62550  IF A>8 AND A$="*" THEN FOR B=A TO 11:WC(B)=0:NEXT:A=12:GOTO *WCGEN_NEXT
62560  IF A$="?" THEN WC(A)=0:GOTO *WCGEN_NEXT
62570  WC(A)=1:MID$(WCS$,A+1,1)=A$
62580  *WCGEN_NEXT
62590 NEXT
62600 WCT$="":FOR A=1 TO KLEN(WCS$):A$=KMID$(WCS$,A,1):IF INSTR("abcdefghijklmnopqrstuvwxyz",A$)<>0 THEN A$=CHR$(ASC(A$)-32)
62610 WCT$=WCT$+A$:NEXT:SWAP WCT$,WCS$
62620 PATH_ALL$="*.*"+CHR$(0)
62630 A=CALLM (OFFSET&,0,VARPTR(PATH_ALL$),VARPTR(FILE_NAME$(1)),&H10,0)
62640 ROOT=0
62650 IF A<>0 THEN FILE_SU=0:RETURN
62660 IF KMID$(FILE_NAME$(1),2,1)="." THEN ROOT=2
62670 IF ASC(FILE_NAME$(1))=68 THEN FILE_NAME$(1)="1<"+MID$(FILE_NAME$(1),2,12)+">":I=1 ELSE I=1:GOSUB *WC_CHK
62680 FOR I=I+1 TO 256
62690     A=CALLM (OFFSET&,0,VARPTR(PATH_ALL$),VARPTR(FILE_NAME$(I)),&H10,1)
62700     IF A<>0 THEN FILE_SU=I-1:I=300:GOTO *LOOPOUTC
62710     IF ASC(FILE_NAME$(I))=68 THEN FILE_NAME$(I)="1<"+MID$(FILE_NAME$(I),2,12)+">" ELSE GOSUB *WC_CHK
62720 *LOOPOUTC
62730 NEXT I
62740 IF I<280 THEN FILE_SU=256
62750 RETURN
62760 *WC_CHK
62770  WCT$=FNFF$(MID$(FILE_NAME$(I),2,12))
62780  FOR J=0 TO 11:IF WC(J)=0 THEN MID$(WCT$,J+1,1)=CHR$(0)
62790  NEXT
62800  IF WCT$<>WCS$ THEN I=I-1:RETURN
62810  FILE_NAME$(I)="2 "+MID$(FILE_NAME$(I),2,12)+" "
62820 RETURN
62870 *SORT
62880 I=FILE_SU\2
62890 J=1:FLG=0
62900 *SORT1
62910 IF J+I>FILE_SU THEN IF FLG=1 THEN J=1:FLG=0 ELSE I=I\2:J=1:FLG=0:IF I=0 THEN *SCROLL_CALC
62920 IF FILE_NAME$(J)>FILE_NAME$(J+I) THEN SWAP FILE_NAME$(J),FILE_NAME$(J+I):FLG=1
62930 J=J+1
62940 GOTO *SORT1
62950 *SCROLL_CALC
62960 F_S=FILE_SU-ROOT:LINE(FDXM+38,FDYM+94)-(FDXM+153,FDYM+265),PSET,7,BF,%8
62970 IF F_S<10 THEN BOX_S!=1:BOX_RH=0:BOX_H=130:B_MAX=243:RETURN
62980 BOX_S!=130/F_S
62990 BOX_RH=BOX_S!*9:BOX_H=130-BOX_RH:B_MAX=113+BOX_H
63000 RETURN
63010 *HYOUJI
63020 GOSUB *SCROLL_BAR:IF MOFF=1 THEN COLOR 1 ELSE COLOR 7
63030 IF F_S<9 THEN F_NUM_HYO=FILE_SU ELSE F_NUM_HYO=F_NUM+8+ROOT
63040 IF ( ROOT=2 AND F_NUM_HYO=2 ) OR FILE_SU=0 THEN *HYOUJI_RET
63050 FOR J=F_NUM+ROOT TO F_NUM_HYO
63060     LOCATE FDX+5,FDY+5+J-(F_NUM+ROOT):IF LEFT$(FILE_NAME$(J),1)="1" THEN PRINT MID$(FILE_NAME$(J),2,14) ELSE PRINT " "+FNFF$(MID$(FILE_NAME$(J),3,12))+" "
63070 NEXT J
63080 *HYOUJI_RET
63090 COLOR 7:RETURN
63100 *HYOUJI_SPC
63110 FOR J=0 TO 8
63120     LOCATE FDX+5,FDY+5+J:PRINT SPC(14)
63130 NEXT J
63140 LOCATE FDX+6,FDY+15:PRINT SPC(12)
63150 RETURN
63160 *DRV_HYO
63170 LOCATE FDX+11,FDY+2:PRINT AKCNV$(MID$(DRV_SET$,DRV_NO,1))
63175 'I=ASC(MID$(DRV_SET$,DRV_NO,1))-ASC("A")
63180 'LOCATE FDX+11,FDY+2:PRINT KNJ$(9025+I)
63190 RETURN
63200 *DISK_FREE
63210 DFREE&=0
63220 DFREE&=DSKF(ASC(MID$(DRV_SET$,DRV_NO,1))-ASC("A"))
63230 LOCATE FDX+30,FDY+1:IF DFREE&<1024 THEN PRINT USING "#,###KB";DFREE& ELSE PRINT USING "###.#MB";DFREE&/1024
63240 RETURN
63250 *接続ドライブ
63260 DRV_SET$=""
63270 J=0:A&=0
63280 INFOR$=STRING$(200,0)
63290 CALLM OFFSET&,7,VARPTR(INFOR$)
63300 A&=PEEK(VARPTR(INFOR$),4)
63310 FOR I&=&H30 TO &H4F STEP 2
63320      IF PEEK(A&+I&)<>255 THEN DRV_SET$=DRV_SET$+CHR$(&H41+J)
63330  J=J+1
63340 NEXT
63350 DRV_SET$=DRV_SET$+"Q"
63360 DRV_SU=LEN(DRV_SET$)
63370 RETURN
63380 *PUT_FDMES
63390 FDMT$=LEFT$(FDM$,68):IF LEN(FDMT$)=68 THEN IF KTYPE(FDM$,KLEN(FDMT$))=1 THEN FDMT$=LEFT$(FDM$,67)
63400 LOCATE FDX+4,FDY+16:PRINT SPC(40):LOCATE FDX+4,FDY+17:PRINT SPC(40)
63410 LOCATE FDX+4,FDY+16
63420 WHILE LEN(FDMT$)>0
63430  IF KTYPE(FDMT$,1)=1 AND POS(0)=FDX+37 THEN PRINT " ";
63440  IF POS(0)>FDX+37 THEN LOCATE FDX+4,FDY+17:IF LEN(FDMT$)>34 THEN IF KTYPE(FDMT$,KLEN(FDMT$))=1 THEN FDMT$=KLEFT$(FDMT$,KLEN(FDMT$)-1) ELSE FDMT$=LEFT$(FDMT$,34)
63450  PRINT KLEFT$(FDMT$,1);:IF LEN(FDMT$)<>0 THEN FDMT$=KRIGHT$(FDMT$,KLEN(FDMT$)-1)
63460 WEND
63470 COLOR 7,,,0
63480 RETURN
63490 *NOT_DRV
63500 BEEP:M$="指定されたディスク装置が使用可能な状態になっていません"
63510 COLOR 2,,,4
63520 SWAP FDM$,M$:GOSUB *PUT_FDMES
63530 WHILE MOUSE(2,0)=0 AND MOUSE(2,1)=0:WEND
63540 SWAP FDM$,M$:GOSUB *PUT_FDMES
63550 FILE_SU=0
63560 ROOT=0
63570 MOFF=1
63580 RETURN
63590 *エラー処理
63600 IF ERR=72 THEN GOSUB *NOT_DRV
63610 RESUME NEXT
63620 *CLICK_AREA
63630 DATA  41, 26,76 , 64 :'  ドライブ移動左ボタンの範囲
63640 DATA  76, 26,116, 64 :'  ドライブ決定ボタンの範囲
63650 DATA 116, 26,153, 64 :'  ドライブ移動右ボタンの範囲
63660 DATA 172, 74,194, 92 :'   親ディレクトリ移動ボタンの範囲
63670 DATA  38, 93,153,264 :'   ファイル一覧枠の範囲
63680 DATA 172, 94,194,112 :'   ファイルアップボタンの範囲
63690 DATA 172,245,194,264 :'   ファイルダウンボタンの範囲
63700 DATA 172,282,209,304 :'   実行ボタンの範囲
63710 DATA 220,282,257,304 :'   取消ボタンの範囲
63720 DATA  38,283,153,302 :'   選択ファイル枠の範囲
63730 DATA 172,112,194,245 :'   スクロールバーの範囲
63740 DATA 198, 74,311,264 :'   ラジオボタンの範囲